Excelmacros – html正文发送电子邮件时格式不正确

我正在使用ExcelmacrosVB脚本和发送电子邮件给用户与邮件正文复制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。

Answer 1

即使我面对这样的情况，我采取了不同的方法，并使用一个经常性的文件作为模板，并用所需的内容replace其内容。 这可能会帮助你。

  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