The code below needs references. Native VBA is limited; it knows nothing about MailItems or Worksheets or Documents or Tables or any other object used by an Office product.
Within the Outlook VBA Editor, click "Tools" then "References". A long list of libraries will be displayed with a few at the top ticked. These ticked libraries will include "Microsoft Library nn.0 Object Library". The value for "nn" will depend on the version of Outlook you use. It is this library that tells VBA about Folders and MailItems and all the other Outlook objects.
The code below needs references to "Microsoft Scripting Runtime" and "Microsoft ActiveX Data Objects n.n Library". On my system, "n.n" is "6.1". If these libraries are not ticked, scroll down the list until you find them and tick them. Next time you click References, these libraries will be at the top of the list.
You say the emails you need to process, all have the same format. You say the data you need is held as a table. Do you mean an Html table or a text table with non-break-spaces to align columns? Tables can look the same but be formatted in very different ways. The code below is the routine I use when I need to investigate the exact format of one or two emails. The answer I referenced above includes the routine I use if I want to investigate lots of emails.
To use the routine below, Insert a new module without Outlook and copy the code below to it. Select one or two of the emails you wish to process and then run InvestigateEmails()
. It will create a file on your desktop named "InvestigateEmails.txt" that will contain a few properties of the selected emails. In particular, it will contain the text and Html bodies. The control characters CR, LF and TB will have been replaced by strings but otherwise these bodies will be as they look to a VBA macro. You cannot extract the destination email addresses from the available body or bodies without knowing how they look to a VBA macro.
I said this is the routine I use to investigate one or two emails. This is not the entire truth. My routine outputs many more properties but I have deleted all but those I thought would be useful to you. I can add more properties if I have missed something you need.
Option Explicit
Public Sub InvestigateEmails()
' Outputs properties of selected emails to a file.
' ??????? No record of when originally coded
' 22Oct16 Output to desktop file rather than Immediate Window.
' Technique for locating desktop from answer by Kyle:
' http://stackoverflow.com/a/17551579/973283
' Needs reference to "Microsoft Scripting Runtime"
Dim Exp As Explorer
Dim FileBody As String
Dim Fso As FileSystemObject
Dim ItemCrnt As MailItem
Dim Path As String
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Pleaase select one or more emails then try again", vbOKOnly)
Exit Sub
Else
FileBody = ""
For Each ItemCrnt In Exp.Selection
With ItemCrnt
FileBody = FileBody & "From (Sender): " & .Sender & vbLf
FileBody = FileBody & "From (Sender name): " & .SenderName & vbLf
FileBody = FileBody & "From (Sender email address): " & _
.SenderEmailAddress & vbLf
FileBody = FileBody & "Subject: " & CStr(.Subject) & vbLf
Call OutLongText(FileBody, "Text: ", Replace(Replace(Replace(.Body, vbLf, _
"{lf}" & vbLf), vbCr, "{cr}"), vbTab, "{tb}"))
Call OutLongText(FileBody, "Html: ", Replace(Replace(Replace(.HtmlBody, vbLf, _
"{lf}" & vbLf), vbCr, "{cr}"), vbTab, "{tb}"))
FileBody = FileBody & "--------------------------" & vbLf
End With
Next
End If
Call PutTextFileUtf8NoBOM(Path & "\InvestigateEmails.txt", FileBody)
End Sub
Public Sub OutLongText(ByRef FileBody As String, ByVal Head As String, _
ByVal Text As String)
Dim PosEnd As Long
Dim LenOut As Long
Dim PosStart As Long
If Text <> "" Then
PosStart = 1
Do While PosStart <= Len(Text)
PosEnd = InStr(PosStart, Text, vbLf)
If PosEnd = 0 Or PosEnd > PosStart + 100 Then
' No LF in remainder of text or next 100 characters
PosEnd = PosStart + 99
LenOut = 100
Else
' Output upto LF. Restart output after LF
LenOut = PosEnd - PosStart
PosEnd = PosEnd
End If
If PosStart = 1 Then
FileBody = FileBody & Head
Else
FileBody = FileBody & Space(Len(Head))
End If
FileBody = FileBody & Mid$(Text, PosStart, LenOut) & vbLf
PosStart = PosEnd + 1
Loop
End If
End Sub
Public Sub PutTextFileUtf8NoBOM(ByVal PathFileName As String, ByVal FileBody As String)
' Outputs FileBody as a text file named PathFileName using
' UTF-8 encoding without leading BOM
' Needs reference to "Microsoft ActiveX Data Objects n.n Library"
' Addition to original code says version 2.5. Tested with version 6.1.
' 1Nov16 Copied from http://stackoverflow.com/a/4461250/973283
' but replaced literals with parameters.
' 15Aug17 Discovered routine was adding an LF to the end of the file.
' Added code to discard that LF.
' 11Oct17 Posted to StackOverflow
' 9Aug18 Comment from rellampec suggested removal of adWriteLine from
' WriteTest statement would avoid adding LF.
' 30Sep18 Amended routine to remove adWriteLine from WriteTest statement
' and code to remove LF from file. Successfully tested new version.
' References: http://stackoverflow.com/a/4461250/973283
' https://www.w3schools.com/asp/ado_ref_stream.asp
Dim BinaryStream As Object
Dim UTFStream As Object
Set UTFStream = CreateObject("adodb.stream")
UTFStream.Type = adTypeText
UTFStream.Mode = adModeReadWrite
UTFStream.Charset = "UTF-8"
UTFStream.Open
UTFStream.WriteText FileBody
UTFStream.Position = 3 'skip BOM
Set BinaryStream = CreateObject("adodb.stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Mode = adModeReadWrite
BinaryStream.Open
UTFStream.CopyTo BinaryStream
UTFStream.Flush
UTFStream.Close
Set UTFStream = Nothing
BinaryStream.SaveToFile PathFileName, adSaveCreateOverWrite
BinaryStream.Flush
BinaryStream.Close
Set BinaryStream = Nothing
End Sub