のLotus Notesは、HTMLボディマクロを挿入し、私はロータスノーツを経由してExcelから自動メールを送信するマクロを持っているエクセル

Question

から送信します。問題は、ボディをHTMLとして送信しないことです。プレーンテキストとして送信します。

この行には問題があります。

.inserttext ("some text" & RangetoHTML(rng)) 

全体のコードは以下の通りです。

Sub Send_Row() 

Dim OutApp As Object 
Dim OutMail As Object 
Dim cell As Range 
Dim rng As Range 
Dim Ash As Worksheet 
Dim strbody As String 
Dim signature As String 
Dim tekstas As String 

Dim noSession As Object 
Dim noDatabase As Object 
Dim noDocument As Object 
Dim noEmbedObject As Object 
Dim noAttachment As Object 
Dim stAttachment As String 

answer = MsgBox("Yes - siųsti visiems išskyrus dėl tegų" & vbNewLine & "No - siųsti tik dėl nesuvestų tegų (laiškai bus iškart išsiųsti(" & vbNewLine & "Cancel - nutraukti siuntimą", vbYesNoCancel + vbQuestion, "Siųsti laiškus?") 
If answer = vbYes Then 

Exit sub 

ElseIf answer = vbNo Then 
tekstas = "<p style='font-size:12pt;font face:""Trebuchet MS""'> Laba diena,<br> <br> Siunčiu mokėjimo kortelių sandorius, kuriems nėra suvesti kliento sutikimo tegai CRD_SUTIK_DATA ir/ar CRD_SUTIK_DUOM. Prašau juos suvesti ir mane informuoti. Ačiū.<br><br> Geros dienos!" 

For Each cell In Ash.Columns("B").Cells.SpecialCells(xlCellTypeConstants) 
    If cell.Value Like "?*@?*.?*" _ 
     And LCase(cell.Offset(0, 23).Value) = "klaida" Then 
     On Error Resume Next 
     'Change the filter range and filter Field if needed 
     'It will filter on Column B now (mail addresses) 
     Ash.Range("A28:AJ10000").AutoFilter Field:=2, Criteria1:=cell.Value 
     Ash.Range("A28:AJ10000").AutoFilter Field:=25, Criteria1:="klaida" 

     With Ash.AutoFilter.Range 
      On Error Resume Next 
      Set rng = .SpecialCells(xlCellTypeVisible) 
      On Error GoTo 0 
     End With 

Set noSession = CreateObject("Notes.NotesSession") 
Set noDatabase = noSession.GETDATABASE("", "") 
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL 
Set noDocument = noDatabase.CreateDocument 

     On Error Resume Next 

noSession.ConvertMIME = False 

Dim workspace As Variant 

noDocument.PostedDate = Now() 

With noDocument 
    .Form = "Memo" 
    .SendTo = cell.Value 
    .Subject = "labas" 
    .Body = "" 
    .SaveMessageOnSend = True 
    .PostedDate = Now() 
End With 

Set workspace = CreateObject("Notes.NotesUIWorkspace") 
Set notesUIDoc = workspace.EditDocument(True, noDocument) 

With notesUIDoc 
    .gotofield "Body" 
    .inserttext ("some text" & RangetoHTML(rng)) 
    .SaveMessageOnSend = True 
    '.send 
    .Close 
End With 

    On Error GoTo 0 

    Ash.AutoFilterMode = False 

    Columns("B:B").Select 
    Selection.Replace What:=cell.Value, Replacement:="", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 

    End If 
Next cell 
Else 
GoTo cleanup 
End If 

cleanup: 
ActiveSheet.Range("$A$28:$AJ$12000").AutoFilter 

Set noEmbedObject = Nothing 
Set noAttachment = Nothing 
Set noDocument = Nothing 
Set noDatabase = Nothing 
Set noSession = Nothing 
End Sub 

Function RangetoHTML(rng As Range) 

Dim fso As Object 
Dim ts As Object 
Dim TempFile As String 
Dim TempWB As Workbook 

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 

rng.Copy 
Set TempWB = Workbooks.Add(1) 
With TempWB.Sheets(1) 
    .Cells(1).PasteSpecial Paste:=8 
    .Cells(1).PasteSpecial xlPasteValues, , False, False 
    .Cells(1).PasteSpecial xlPasteFormats, , False, False 
    .Cells(1).Select 
    Application.CutCopyMode = False 

    Columns(1).EntireColumn.Delete 
    Columns(32).EntireColumn.Delete 
    Columns(33).EntireColumn.Delete 

    On Error Resume Next 
    .DrawingObjects.Visible = True 
    .DrawingObjects.Delete 
    On Error GoTo 0 
End With 

With TempWB.PublishObjects.Add(_ 
    SourceType:=xlSourceRange, _ 
    Filename:=TempFile, _ 
    Sheet:=TempWB.Sheets(1).Name, _ 
    Source:=TempWB.Sheets(1).UsedRange.Address, _ 
    HtmlType:=xlHtmlStatic) 
    .Publish (True) 
End With 

Set fso = CreateObject("Scripting.FileSystemObject") 
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) 
RangetoHTML = ts.ReadAll 
ts.Close 
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ 
         "align=left x:publishsource=") 

TempWB.Close savechanges:=False 

Kill TempFile 

Set ts = Nothing 
Set fso = Nothing 
Set TempWB = Nothing 
End Function 

Answer 1

設計どおりに動作します。 InsertTextはフィールドにプレーンテキストを挿入するだけです。あなたは、バックエンドクラスを使用する必要があるだろうとのNotesDocument NotesRichtextItemまたはあなたが