0

Is it possible to send tables from excel to outlook? I want to send the tables as image (Bitmap), so the formating remains nice.

I have 2 tables with data in excel, which I need to send every day. I want to do it more smooth.

At the moment I have this code:

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 = "TEST@gmail.com"
     .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

This code opens outlook, but it does not paste the anything. Any suggestions? And what do I do if I also want to paste a second table from sheet2?

Dharman
  • 30,962
  • 25
  • 85
  • 135

1 Answers1

0

Applying the code from my link mentioned in the comments above

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 = "TEST@gmail.com"
        .Subject = "TEST"
        wordDoc.Range.pasteandformat 13

    End With
    On Error GoTo 0

End Sub
Storax
  • 11,158
  • 3
  • 16
  • 33