Copy Table as Bitmap and Paste into Outlook

Copper Contributor

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 email to send out the report
    Set olApp = New Outlook.Application
    Set olMail = olApp.CreateItem(olMailItem)
    Dim message As String
    Dim rng As Range
    Dim Sht As Excel.Worksheet
    
    strDate = Format(tDatePreviousBusDate, "mm-dd-yy")
     
    txtSignature = "C:\Documents and Settings\" & Environ("username") & _
                "\Application Data\Microsoft\Signatures\Standard.txt"

    If Dir(txtSignature) <> "" Then
        Signature = GetBoiler(txtSignature)
    Else
        Signature = ""
    End If
    
    Set Sht = ActiveWorkbook.Sheets("Pivot")
    Set rng = Sht.Range("A1:I101")
        rng.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

    With olMail
        .SentOnBehalfOfName = ""
        .To = "New Deal Closed"
        .CC = ""
        .Subject = "Deals Closed" & " (" & strDate & ")"
        .Body = Format("Activity as of " & strDate, Bold)
            Range.PasteSpecial
        .Attachments.Add OutputPath & OutputFile
        .Display '.Send
        
    End With
End Sub

 

When I run this code, I get a "Argument not optional" error and it highlights row 31. I know I don't have the correct code to paste the table in bitmap format, does anyone know how I can do that? Any help is much appreciated, thank you!

1 Reply

@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