excel - 通过 Outlook 电子邮件发送 Excel 形状

Question

我已经编写了这段代码，我想通过电子邮件发送 Excel 中已经存在的图像(称为 Picture 1810)。但我不知道怎么做 .Body .

任何人都可以帮助我吗？

Sub CreateMail()    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngCC As Range
    Dim rngSubject As Range
    Dim rngBody As Shape
    Dim rngAttach As Range

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With ActiveSheet
        Set rngTo = .Range("f2")
        Set rngCC = .Range("f3")
        Set rngSubject = .Range("c2")
        Set rngBody = .Shapes("Picture 1810")
    End With

    With objMail
        .To = rngTo.Value
        .CC = rngCC.Value
        .Subject = rngSubject.Value
        .Body = rnbbody
        .Send
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngSubject = Nothing
    Set rngBody = Nothing
    Set rngAttach = Nothing
End Sub

Answer 1

通过这种方式，您可以保留您的标准电子邮件签名，并将形状粘贴在正文上或像中间的字符一样:

With objMail
    .To = rngTo.Value
    .CC = rngCC.Value
    .Subject = rngSubject.Value
    .Display
    Dim wdDoc As Word.Document
    Set wdDoc = .GetInspector.WordEditor
    If Not wdDoc Is Nothing Then
        With wdDoc.Range
            .Collapse wdCollapseStart
            .InsertBefore "Hi there," & vbCrLf & "here's my shape:" & vbCrLf
            .Collapse wdCollapseEnd
            .InsertAfter vbCrLf & "Best wishes," & vbCrLf
            .Collapse wdCollapseStart

            ActiveSheet.Shapes("Picture 1810").Copy
            '.Paste ' over the text
            .PasteAndFormat wdChartPicture ' within text
        End With
        Set wdDoc = Nothing
    End If
    '.Send
End With