VBA：将表格从 Excel 发送到 Outlook [重复]

Posted 2023-04-19

【中文标题】VBA：将表格从 Excel 发送到 Outlook [重复]

【英文标题】：VBA: Send table from Excel to Outlook [duplicate]

【发布时间】：2019-12-27 09:20:01

【问题描述】：

是否可以将表格从excel发送到outlook？我想将表格作为图像（位图）发送，所以格式仍然很好。

我有 2 个包含 excel 数据的表格，我需要每天发送。我想做得更流畅。

目前我有这个代码：

Sub SendEmail()

Dim OutlookApp As Object
Dim OutlookMessage As Object


Sheets("SHEET1").Range("B5:AE37").Select
Selection.Copy


On Error Resume Next
Set OutlookApp = GetObject(class:="Outlook.Application")
Err.Clear
If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(class:="Outlook.Application")

Set OutlookMessage = OutlookApp.CreateItem(0)

On Error Resume Next
    With OutlookMessage
     .display
     .To = "[e-mail]"
     .Subject = "TEST"
     .body = Selection.Paste 'THIS IS NOT CORRECT. HOW DO I PASTE THE TABLE HERE?? Can I paste as Bitmap?
    End With
On Error GoTo 0

End Sub

此代码会打开 Outlook，但不会粘贴任何内容。 有什么建议么？如果我还想从 sheet2 粘贴第二个表格，该怎么办？

【参考方案1】：

应用上面 cmets 中提到的我的链接中的代码

Sub SendEmail()

    Dim OutlookApp As Object
    Dim OutlookMessage As Object


    Dim rg As Range
    Set rg = Worksheets("SHEET1").Range("B5:AE37")
    rg.CopyPicture



    On Error Resume Next
    Set OutlookApp = GetObject(class:="Outlook.Application")
    Err.Clear
    If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(class:="Outlook.Application")

    Set OutlookMessage = OutlookApp.CreateItem(0)

    Dim wordDoc As Object 'Word.Document
    Set wordDoc = OutlookMessage.GetInspector.WordEditor

    On Error Resume Next
    With OutlookMessage
        .display
        .To = "[e-mail]"
        .Subject = "TEST"
        wordDoc.Range.pasteandformat 13

    End With
    On Error GoTo 0

End Sub