[英]Excel macro - html body not well formatted while sending email
I am using excel macro VB script and sending emails to users with Excel content copied in mail body. 我正在使用excel宏VB脚本,并使用在邮件正文中复制的Excel内容向用户发送电子邮件。 Excel content is formatted with colors and borders. Excel内容使用颜色和边框设置格式。 When the mail is received, formatting is removed and I can only see plain text. 收到邮件后,格式被删除,我只能看到纯文本。
Code - 代码-
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
Function = RangeToHTML - 函数= 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
Please help me here in sending email with html formatting. 请在这里帮助我发送html格式的电子邮件。
Thanks, Sanket. 谢谢,桑凯特。
Even I faced such a situation, I took a different approach and used a oft file as a template and replaced its content with the required content. 即使遇到这样的情况,我也采用了不同的方法,并使用了一个文件作为模板,并用所需的内容替换了其内容。 This might help you. 这可能对您有帮助。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.