Excel宏 - html正文在发送电子邮件时格式不正确

时间:2017-09-05 07:42:27

标签: html excel vba excel-vba

我正在使用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格式的电子邮件。

谢谢, SANKET。

1 个答案:

答案 0 :(得分: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