1
votes

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!

1
How would you use Outlook Object Model to open an EML file? So what you really need is a MIME parser, right?Dmitry Streblechenko

1 Answers

0
votes

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