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