VBA宏向Outlook邮件粘贴表格时内容顺序颠倒问题求助

嗨，我仔细看了你的VBA代码，马上发现问题所在啦——你现在的代码把自定义的HTML文本放在了邮件原有内容（也就是你粘贴的表格图片）的前面，自然会出现文本在前、表格在后的颠倒情况。

问题根源分析 #

你先通过wordDoc.Range.PasteandFormat wdChartPicture把表格图片粘贴到了邮件里，这时候邮件的.HTMLBody已经包含了这个表格的内容。但之后你设置.HTMLBody = 新HTML文本 & .HTMLBody，相当于把新文本追加到了原有内容的前面，这就和你想要的“表格在上，文本在下”的顺序完全相反了。

解决办法 #

方法一：调整HTMLBody的拼接顺序

只需要把拼接顺序反过来，把原有.HTMLBody放在前面，自定义文本放在后面就行，修改后的核心代码片段如下：

With OutMail
    .to = "someone@gmail.com"
    .Subject = "Country Population Data " & Format(Date, "mm-dd-yy")
    .Display
    Set wordDoc = OutMail.GetInspector.WordEditor
    wordDoc.Range.PasteandFormat wdChartPicture
    ' 关键修改：把原有HTMLBody（表格）放在前面，新文本追加到后面
    .HTMLBody = .HTMLBody & "<body style=font-size:11pt;font-family:Calibri>" & _
    "<p><font style=font-size:11pt;font-family:Calibri><b>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
    "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Vitae ultricies leo integer malesuada nunc.</b></p>" & _
    "<p><font style=font-size:9pt;font-family:Calibri>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
    "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.</p>" & _
    "<p><font style=font-size:9pt;font-family:Arial;color:#595959><i>Lorem ipsum dolor sit amet, consectetur adipiscing elit," & _
    "sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Amet consectetur adipiscing elit ut. Mattis aliquam faucibus purus in massa tempor." & _
    "Hendrerit dolor magna eget est.</i></font></p>"
End With

方法二：用WordEditor直接插入文本（更推荐）

因为你已经在使用Outlook邮件的Word编辑器对象wordDoc来粘贴表格，不如直接用它来插入后续文本，这样格式衔接更自然，也避免HTML拼接可能出现的兼容问题。修改后的完整代码如下：

Sub sendEmailwithPic()

Dim OutApp As Object
Dim OutMail As Object
Dim table As Range
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

' 抓取表格并转为图片
Set ws = ThisWorkbook.Sheets("Sheet1")
Set table = ws.Range("A1:E11")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut

' 创建邮件内容
On Error Resume Next
With OutMail
    .to = "someone@gmail.com"
    .Subject = "Country Population Data " & Format(Date, "mm-dd-yy")
    .Display
    Set wordDoc = OutMail.GetInspector.WordEditor
    ' 粘贴表格图片
    wordDoc.Range.PasteandFormat wdChartPicture
    
    ' 插入第一段加粗文本
    wordDoc.Range.End.InsertParagraphAfter
    wordDoc.Range.End.Text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit,sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Vitae ultricies leo integer malesuada nunc."
    With wordDoc.Range.End.Font
        .Bold = True
        .Size = 11
        .Name = "Calibri"
    End With
    
    ' 插入第二段常规文本
    wordDoc.Range.End.InsertParagraphAfter
    wordDoc.Range.End.Text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit,sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."
    With wordDoc.Range.End.Font
        .Bold = False
        .Size = 9
        .Name = "Calibri"
    End With
    
    ' 插入第三段斜体灰色文本
    wordDoc.Range.End.InsertParagraphAfter
    wordDoc.Range.End.Text = "Lorem ipsum dolor sit amet, consectetur adipiscing elit,sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Amet consectetur adipiscing elit ut. Mattis aliquam faucibus purus in massa tempor.Hendrerit dolor magna eget est."
    With wordDoc.Range.End.Font
        .Italic = True
        .Size = 9
        .Name = "Arial"
        .Color = RGB(89, 89, 89) ' 对应#595959的灰色
    End With
    
    wordDoc.Range.End.InsertParagraphAfter
End With
On Error GoTo 0

Set OutApp = Nothing
Set OutMail = Nothing
End Sub

方法二的好处是不需要拼接复杂的HTML字符串，直接通过Word对象模型控制文本格式和位置，更直观，也不容易出现格式冲突的问题。如果需要调整样式，直接修改对应的Font属性即可。

备注：内容来源于stack exchange，提问作者BannyM