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格式發送電子郵件。

謝謝， Sanket。

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