用文本和图像填充邮件项目

Populating Mail Item with texts and Images

我在 Excel VBA 中有以下代码:

Sub CreateEmailAndSend()

    Dim outApp As Object
    Dim OutMail As Object
    Set outApp = CreateObject("Outlook.Application")
    Set oMail = outApp.CreateItem(0)
    Dim Doc As Object

    oMail.Display
    Set Doc = outApp.ActiveInspector.WordEditor

    oMail.To = ""
    oMail.Subject = "test"

    ' first sentence
    Dim msg As String
    msg = "Plain Sentence"

    Doc.Range(0, 0) = msg

    ' second sentence comes after
    msg = "Bold and Highlight Yellow Sentence"
    Doc.Range(Len(Doc.Range), Len(Doc.Range)) = msg
    Doc.Range.Font.Bold = True
    Doc.Range.HighlightColorIndex = wdYellow

    ' paste image below it
    Dim imagerng As Range
    Set imagerng = Range(Cells(1, 1), Cells(5, 5))
    imagerng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    Doc.Range(Len(Doc.Range), Len(Doc.Range)).Paste

End Sub

基本上我想做的是创建并显示如下所示的电子邮件:

Plain Sentence
Bold and Highlight Yellow Sentence (this sentence is bold and highlighted)
(bitmap image)
{my signature}

但是,我的代码得到的输出是

Plain Sentence (bold)
(bitmap image) and the second sentence all over {my signature}

我应该如何修复我的代码?

我认为您的问题在于您尝试访问 Word 对象模型中的范围的方式。经过一些谷歌搜索后,我用段落引用替换了你的 Doc.Range(Len(Doc.Range), Len(Doc.Range)). 部分。见下文:

Sub CreateEmailAndSend()

    Dim outApp As Object
    Dim OutMail As Object
    Set outApp = CreateObject("Outlook.Application")
    Set oMail = outApp.CreateItem(0)
    Dim Doc As Object

    oMail.Display
    Set Doc = outApp.ActiveInspector.WordEditor

    oMail.To = ""
    oMail.Subject = "test"

    ' first sentence
    Dim msg As String
    msg = "Plain Sentence"

    Doc.Range(0, 0) = msg

    ' second sentence comes after
    msg = "Bold and Highlight Yellow Sentence"

    Doc.Paragraphs(1).Range.InsertParagraphAfter
    Doc.Paragraphs(2).Range = msg
    Doc.Paragraphs(2).Range.Font.Bold = True
    Doc.Paragraphs(2).Range.HighlightColorIndex = wdYellow


    ' paste image below it
    Dim imagerng As Range
    Set imagerng = Range(Cells(1, 1), Cells(5, 5))
    imagerng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    Doc.Paragraphs(2).Range.InsertParagraphAfter
    Doc.Paragraphs(3).Range.InsertParagraphAfter
    Doc.Paragraphs(3).Range.Paste

End Sub

这对我有用。