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

Question

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?

Answer 1

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