excelvbaoutlook

Export an Excel table to Outlook above the signature


I'm attempting to export a range of cells to Outlook to send off in an email.

My code pastes the range below the signature and not above it.

I used .HTMLBody to create the default signature in Outlook but I can't position in the right place.

Ideally I would add the initial htmlbody text then paste the range then add the default signature using & .HTMLBody.

I tried alternatives such as calling the signature from a .htm file or a .rtf file but this doesn't fit my purposes as I need the user's signature to be inputed automatically.

An excerpt of my code.

'Get the Active instance of Outlook if there is one
    Set oLookApp = GetObject(, "Outlook.Application")
   
        'If Outlook isn't open then create a new instance of Outlook
        If Err.Number = 429 Then
       
            'Clear Error
            Err.Clear
       
            'Create a new instance of Outlook
            Set oLookApp = New Outlook.Application
           
        End If
       
    'Create a new email
    Set oLookItm = oLookApp.CreateItem(olMailItem)
    Set CopyRange1 = ThisWorkbook.Worksheets("TEST EMAILS").Range("Z2").CurrentRegion
         
    'Create an array to hold ranges
    With oLookItm
   
        'Define some basic info of our email
        .To = xyz@abc.com
        .CC = Team@email.com
        .BCC = EmailAddresses
        .Subject = "Here are all of my Prices"
        .Display
       
       .HTMLBody = "<span style='background:yellow;mso-highlight:yellow'>" & "SENSITIVE INFORMATION" & "<a href="SENSITIVE INFORMATION"><u><b>SENSITIVE INFORMATION </a></u></b></span><br><br>" & "<img src='C:\Users\User\Pictures\Picture1.png'><br>" & "SENSITIVE INFORMATION<br>" & "SENSITIVE INFORMATION &" & "<b><u> SENSITIVE INFORMATION </b></u>" & "SENSITIVE INFORMATION<br>" & "SENSITIVE INFORMATION" & "<b><font color=red> SENSITIVE INFORMATION </font></b>" & "SENSITIVE INFORMATION<br>" & "<b>SENSITIVE INFORMATION</b>" & .HTMLBody
       
        'Display the email
       
        
        'Get the Active Inspector
        Set oLookIns = .GetInspector
       
        'Get the document within the inspector
        Set oWrdDoc = oLookIns.WordEditor
       
        CopyRange1.Copy
 
      
        
        'Define the range, insert a blank line, collapse the selection.
        Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content
            oWrdRng.Collapse Direction:=wdCollapseEnd
           
         
        'Add a new paragragp and then a break
        Set oWrdRng = oWdEditor.Paragraphs.Add
            oWrdRng.InsertBreak
                   
        'Paste the object.
        oWrdRng.PasteSpecial DataType:=wdPasteHTML
       
    CopyRange1.Delete
    End With
   
Unload UserForm2

Solution

  • This worked for me - replaces a placeholder in the content with the pasted range from Excel:

    'add references to Word and Outlook object models...
    Sub Tester77()
        Const TABLE_PLACEHOLDER As String = "XXXtableXXX"
        Dim oLookApp As Outlook.Application, oLookItm As Outlook.MailItem
        Dim oLookIns As Outlook.Inspector, oWrdDoc As Word.Document, oWrdRng As Word.Range, CopyRange1 As Range
        
        Set CopyRange1 = ThisWorkbook.Worksheets("TEST EMAILS").Range("Z2").CurrentRegion
    
        On Error Resume Next
        Set oLookApp = GetObject(, "Outlook.Application")
        On Error GoTo 0
        If oLookApp Is Nothing Then Set oLookApp = New Outlook.Application
               
        With oLookApp.CreateItem(olMailItem)
            '.To = xyz@abc.com
            '.CC = Team@email.com
            '.BCC = EmailAddresses
            .Subject = "Here are all of my Prices"
            .Display
           
           .HTMLBody = "<span style='background:yellow;mso-highlight:yellow'>" & _
             "SENSITIVE INFORMATION" & "<a href=""SENSITIVE INFORMATION""><u>" & _
             "<b>SENSITIVE INFORMATION </a></u></b></span><br><br>" & _
             "<img src='C:\Users\User\Pictures\Picture1.png'><br>" & _
             "SENSITIVE INFORMATION<br>" & "SENSITIVE INFORMATION " & _
             "<b><u> SENSITIVE INFORMATION </b></u>" & _
             "SENSITIVE INFORMATION<br>" & "SENSITIVE INFORMATION" & _
             "<b><font color=red> SENSITIVE INFORMATION </font></b>" & _
             "SENSITIVE INFORMATION<br>" & "<b>SENSITIVE INFORMATION</b><br><br>" & _
             TABLE_PLACEHOLDER & .HTMLBody
           
            Set oLookIns = .GetInspector
            Set oWrdDoc = oLookIns.WordEditor
            Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content
            
            'find the table placeholder and paste the Excel range
            With oWrdRng.Find
                .Text = TABLE_PLACEHOLDER
                If .Execute Then
                    CopyRange1.Copy
                    'If the `Find` succeeded then `oWrdRng` is 
                    ' now pointing to the range for the found text
                    oWrdRng.PasteSpecial DataType:=wdPasteHTML
                End If
            End With
        
        End With
    End Sub