Copy Table as Bitmap and Paste into Outlook

Hi everyone, I am trying to copy a table in bitmap format and paste it into the body of an outlook email in VBA. Below is the code I have so far.. Sub Create_Email() 'This creates the emai...

Macros and VBA

djclements

Feb 13, 2024

BriceChapman There are a number of undefined or unused variables in your code, so I've excluded them from the sample below. Please adjust the following code to meet your needs:

Sub Create_Email()

'Copy the desired range as a picture
    Dim ws As Worksheet, rg As Range
    Set ws = ThisWorkbook.Sheets("Pivot")
    Set rg = ws.Range("A1:I101")
    rg.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

'Set the date string to be used in the email
    Dim strDate As String
    strDate = Format(Date - 1, "mm-dd-yy")

'Create a new Outlook email
    Dim olApp As Object, olMail As Object
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0) 'olMailItem
    With olMail
        .SentOnBehalfOfName = ""
        .To = "New Deal Closed"
        .CC = ""
        .BCC = ""
        .Subject = "Deals Closed (" & strDate & ")"
        .Display

    ' paste the picture into the body, followed by a basic signature
        Dim wordDoc As Variant
        Set wordDoc = .GetInspector.WordEditor
        With wordDoc.Range
            .PasteSpecial DataType:=4 'wdPasteBitmap
            .InsertParagraphAfter
            .InsertParagraphAfter
            .InsertAfter "Thank you,"
            .InsertParagraphAfter
            .InsertAfter "John Smith"
        End With

    ' apply formatting and insert greeting before the picture
        .HTMLBody = "<BODY style = font-size:11pt; font-family:Calibri;>" & _
            "<p><b>Activity as of " & strDate & "</b></p>" & .HTMLBody

    End With

    Set olApp = Nothing
    Set olMail = Nothing

End Sub

References: Excel VBA Macro: Paste Range (Table) As Image In Email Body

djclements

Silver Contributor

Feb 13, 2024

BriceChapman There are a number of undefined or unused variables in your code, so I've excluded them from the sample below. Please adjust the following code to meet your needs:

Sub Create_Email()

'Copy the desired range as a picture
    Dim ws As Worksheet, rg As Range
    Set ws = ThisWorkbook.Sheets("Pivot")
    Set rg = ws.Range("A1:I101")
    rg.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

'Set the date string to be used in the email
    Dim strDate As String
    strDate = Format(Date - 1, "mm-dd-yy")

'Create a new Outlook email
    Dim olApp As Object, olMail As Object
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(0) 'olMailItem
    With olMail
        .SentOnBehalfOfName = ""
        .To = "New Deal Closed"
        .CC = ""
        .BCC = ""
        .Subject = "Deals Closed (" & strDate & ")"
        .Display

    ' paste the picture into the body, followed by a basic signature
        Dim wordDoc As Variant
        Set wordDoc = .GetInspector.WordEditor
        With wordDoc.Range
            .PasteSpecial DataType:=4 'wdPasteBitmap
            .InsertParagraphAfter
            .InsertParagraphAfter
            .InsertAfter "Thank you,"
            .InsertParagraphAfter
            .InsertAfter "John Smith"
        End With

    ' apply formatting and insert greeting before the picture
        .HTMLBody = "<BODY style = font-size:11pt; font-family:Calibri;>" & _
            "<p><b>Activity as of " & strDate & "</b></p>" & .HTMLBody

    End With

    Set olApp = Nothing
    Set olMail = Nothing

End Sub

References: Excel VBA Macro: Paste Range (Table) As Image In Email Body

BriceChapman
Copper Contributor
Mar 06, 2024
Thank you so much! You are a savior

Forum Discussion

Copy Table as Bitmap and Paste into Outlook

Resources