Paste Table Copied From Website into Body of Outlook Email Using VBA

user_4462995 0
Viewed 52

I have this code that creates an email, fills in the to, cc, subject fields; and I want it to text the table that I manually copied from the Internet. So basically I want it to do a ctrl-v in the body of the email. I have tried the doclipboard.GetText method and a few other methods. This is the most recent try.

Sub SendEmail(ByVal strSubject As String, ByVal strBody As String, ByVal blnDisplay As Boolean, ByVal blnAddPaste As Boolean)

    Dim bStarted As Boolean
    Dim oOutlookApp As Outlook.Application
    Dim oItem As Outlook.MailItem

    On Error Resume Next

    'Get Outlook if it's running
    Set oOutlookApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        'Outlook wasn't running, start it from code
        Set oOutlookApp = CreateObject("Outlook.Application")
        bStarted = True
    End If

    'Create a new mailitem
    Set oItem = oOutlookApp.CreateItem(olMailItem)

    With oItem
        'Set the recipient for the new email
        .To = "Email Addresses"
        'Set the recipient for a copy
        '.CC = strCC
        'Set the subject
        .Subject = "Salesforce " & EmailDateFormat & " " & strSubject
        'The content of the document is used as the body for the email
        If blnAddPaste Then
            .HTMLBody = strBody & "<br><br>" & _ 
              Selection.PasteAndFormat(Word.WdRecoveryType.wdTableOriginalFormatting) ' this is what I need to fix
        Else
            .HTMLBody = strBody
        End If
        
        
        If blnDisplay Then
            .Display
        Else
            .Send
        End If
    End With

    If bStarted Then
        'If we started Outlook from code, then close it
        oOutlookApp.Quit
    End If

    'Clean up
    Set oItem = Nothing
    Set oOutlookApp = Nothing

End Sub

How do I get a table to paste inside of the outlook email?

outlook vba
1 Answers

I figured it out for anyone else looking for the solution.

Sub SendEmail(ByVal strSubject As String, ByVal strBody As String, ByVal blnDisplay As Boolean, ByVal blnAddPaste As Boolean)

    Dim bStarted As Boolean
    Dim oOutlookApp As Outlook.Application
    Dim oItem As Outlook.MailItem
    Dim oWordDoc As Word.Document
    Dim oWordRange As Word.Range
    Dim VarPosition As Variant

    On Error Resume Next

    'Get Outlook if it's running
    Set oOutlookApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        'Outlook wasn't running, start it from code
        Set oOutlookApp = CreateObject("Outlook.Application")
        bStarted = True
    End If

    'Create a new mailitem
    Set oItem = oOutlookApp.CreateItem(olMailItem)

    With oItem
        If blnDisplay Then
            .Display
        End If
        Set oWordDoc = oItem.GetInspector.WordEditor
        'Set the recipient for the new email
        .To = "Email Addresses"
        'Set the recipient for a copy
        '.CC = strCC
        'Set the subject
        .Subject = "Salesforce " & EmailDateFormat & " " & strSubject
        'The content of the document is used as the body for the email
        If blnAddPaste Then
            .Body = strBody  '& Selection.PasteAndFormat(Word.WdRecoveryType.wdTableOriginalFormatting)
            VarPosition = oWordDoc.Range.End - 1
            Set oWordRange = oWordDoc.Range(VarPosition, VarPosition)
            oWordRange.Select
            oWordRange.PasteAndFormat (Word.WdRecoveryType.wdFormatOriginalFormatting)
            'SendKeys ("^v")
        Else
            .HTMLBody = strBody
        End If
        
        
        If Not blnDisplay Then
            .Send
        End If
    End With

    If bStarted Then
        'If we started Outlook from code, then close it
        oOutlookApp.Quit
    End If

    'Clean up
    Set oItem = Nothing
    Set oOutlookApp = Nothing

End Sub
user_44629950
Related