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