parse the body of an eml file in vba excel - vba

Question

My ultimate goal is to open an eml file in Excel vba and end up with the body of the message in a string that I can then use to search for different parameters. I've found a solution using MailItem and an Outlook application, however the machine I'm working on errors out when running this code:
Set MyOutlook = New Outlook.Application
Set x = MyOutlook.GetNamespace("MAPI")
Outlook 2013 opens, but then gives me an error message saying OLMAPI32.dll and then crashes. Eventually, I receive error 429 "ActiveX component can't create object."
I would like either a solution to this error or a workaround way to get the body of an eml file into a string. I've been successful at getting the subject of the email by using this code:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.Pattern = "^Subject:"
Do Until objFile.AtEndOfStream
strSearchString = objFile.ReadLine
Set colMatches = objRegEx.Execute(strSearchString)
If colMatches.Count > 0 Then
Cells(i, n) = strSearchString
i = i + 1
Exit Do
End If
Loop
However, from examining a few random eml files, it doesn't appear like there is a way to flag the body of the text like I can with the subject.
Disregard the i and n, its not really relevant for this question. I'm just placing the subject in a cell determined elsewhere.
Any help is appreciated. Thanks!

Answer 1

Have you tried using the .Body function? This article may help.
Note that this code is performed inside of Outlook, not Excel.
Sub ExportToExcel(MyMail As MailItem) Dim strID As String, olNS As Outlook.Namespace Dim olMail As Outlook.MailItem Dim strFileName As String
'~~> Excel Variables
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim lRow As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Establish an EXCEL application object
On Error Resume Next
Set oXLApp = GetObject(, "Excel.Application")
'~~> If not found then create new instance
If Err.Number <> 0 Then
Set oXLApp = CreateObject("Excel.Application")
End If
Err.Clear
On Error GoTo 0
'~~> Show Excel
oXLApp.Visible = True
'~~> Open the relevant file
Set oXLwb = oXLApp.Workbooks.Open("C:\Sample.xls")
'~~> Set the relevant output sheet. Change as applicable
Set oXLws = oXLwb.Sheets("Sheet1")
lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 1
'~~> Write to outlook
With oXLws
'
'~~> Code here to output data from email to Excel File
'~~> For example
'
.Range("A" & lRow).Value = olMail.Subject
.Range("B" & lRow).Value = olMail.SenderName
.Range("C" & lRow).Value = olMail.Body
'.Range("C" & lRow).Value = olMail.HTMLBody
'
End With
'~~> Close and Clean up Excel
oXLwb.Close (True)
oXLApp.Quit
Set oXLws = Nothing
Set oXLwb = Nothing
Set oXLApp = Nothing
Set olMail = Nothing
Set olNS = Nothing
End Sub