Question

非常简单直接。我希望在工作表中复制范围，打开一个新的Outlook电子邮件并将范围粘贴为图像。以下代码是我目前拥有的代码。尽管我付出了努力，但我还是无法粘贴成照片。

Sub CreateMail()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngBody As Range

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

With Sheets("Hourly Labor Model")
    Set rngBody = .Range(.Range("A6"), .Range("AA99").End(xlDown))

End With
rngBody.Copy

With objMail
    .To = "user@useremail.com"
    .Subject = "Hourly Dashboard- " & Sheets("Graphs").Range("AA1") & " on " & Format(Now(), "mm/dd/yyyy") & " @ " & Format(Time(), "hh:mm:ss")
    .display


End With
SendKeys "^({v})", True

On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

请提前谢谢你。

Answer 1

基于this thread，我认为以下内容可行：

Sub CreateMail()

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngBody As Range
Dim outMail As Outlook.MailItem 'new

Set objOutlook = CreateObject("Outlook.Application")

Set objMail = objOutlook.CreateItem(0)
Set outMail = objOutlook.CreateItem(olMailItem)


With Sheets("Hourly Labor Model")
    Set rngBody = .Range(.Range("A6"), .Range("AA99").End(xlDown))

End With
rngBody.Copy

With objMail
    .To = "user@useremail.com"
    .Subject = "Hourly Dashboard- " & Sheets("Graphs").Range("AA1") & " on " & Format(Now(), "mm/dd/yyyy") & " @ " & Format(Time(), "hh:mm:ss")
    .Display
'outMail.Display
    Dim wordDoc As Word.Document
    Set wordDoc = .GetInspector.WordEditor ' or use outMail instead of with()
    wordDoc.Range.PasteandFormat wdChartPicture

End With
SendKeys "^({v})", True

On Error GoTo 0
Set outMail = Nothing
Set OutApp = Nothing

End Sub

将Excel工作表范围复制并粘贴到Outlook中作为图片

1 个答案: