Excel宏-發送電子郵件時HTML正文格式不正確

Question

我正在使用excel宏VB腳本，並使用在郵件正文中復制的Excel內容向用戶發送電子郵件。 Excel內容使用顏色和邊框設置格式。 收到郵件后，格式被刪除，我只能看到純文本。

代碼-

With OutMail

.SentOnBehalfOfName = email_from
.To = email_to
.CC = email_cc
.BCC = email_bcc
.subject = subject
.HTMLBody = "Dear All, Please find below today's MIS. <br/>" & RangetoHTML(rng) & "<br/>Regards, <br/> MIS Team <br/>
.Attachments.Add (Attach_Path)
.Send
End With

函數= RangeToHTML-

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"

    'Copy the range and create a new temp workbook to pass. Content from the main sheet is copied to temp sheet.
    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

        'This function is used to delete all hidden columns from the sheet that is used for copying mail content.
        'Hidden columns are removed from temp sheet and not from original sheet which is attached with the email.

        Call fn_To_Delete_Hidden_Columns

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

    'Publish the sheet to a htm file
    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

    'Read all data from the htm file into RangetoHTML
    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

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing

End Function

請在這里幫助我發送html格式的電子郵件。

謝謝，桑凱特。

Answer 1

即使遇到這樣的情況，我也采用了不同的方法，並使用了一個文件作為模板，並用所需的內容替換了其內容。 這可能對您有幫助。

  Sub TempMail()

    Set otlApp = CreateObject("Outlook.Application")
    Set otlNewMail = otlApp.CreateItemFromTemplate("D:\Users\xxxxxx\Desktop\test.oft")
    With otlNewMail
    vTemplateBody = otlNewMail.HTMLBody
    vTemplateSubject = otlNewMail.Subject
    .Close 1
    End With
    x = 2
    Do While Range("B" & x).Formula <> ""

    Set otlApp = CreateObject("Outlook.Application")
    Set otlNewMail = otlApp.CreateItem(0)
    With otlNewMail
    .To = Range("C" & x).Value
    '.SentOnBehalfOfName = vFrom
    '.Bcc = vToList
    .Subject = Range("D" & x).Value


    TempBody = Replace(vTemplateBody, "xxxxx", Range("I" & x).Value)  'Name updated
    TempBody = Replace(TempBody, "xxxx**xx",  Range("B" & x).Value) 'temp changed
    'TempBody = Replace(vTemplateBody, "Remove -", "Remove -" & Range("H" & x).Value) 'Remove changed
    TempBody = Replace(TempBody, "Add", "Add -" & Range("L" & x).Value) 'Add changed

    .HTMLBody = TempBody

    .Display
    End With
    x = x + 1
    Loop
    End Sub