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

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

1 个答案: