Reading from Outlook body to Excel spreadhseet returns blank values with VBA

[egmg1988]

Hello,
I'm new to this forum, I hope I could get some help.

I'm trying to write a piece of VBA code to read emails from an Outlook folder, and populate a spreadsheet with the information from the body.
I'm using Office 2007.

I got the starting code from another thread in this forum and tried to clean all their features except read the body email and put it into a cell.... it starts running, and opens the folder, I'm able to get the subject and other fields, but the .body returns blank everytime.

Any ideas on what's the problem? All help is appreciated.

Option ExplicitPublic gblStopProcessing As Boolean
Sub ParseBlockingSessionsEmailPartOne()
' This macro requires Microsoft Outlook Object Library (Menu: Tools/References) be available
Dim wb As Workbook
Dim ws As Worksheet
Dim objFolder As Object
Dim objNSpace As Object


Dim objOutlook As Object
Set objOutlook = CreateObject("Outlook.Application")


Dim lngAuditRecord As Long
Dim lngCount As Long
Dim lngTotalItems As Long 'Count of emails in the Outlook folder.
Dim lngTotalRecords As Long
Dim i As Integer
Dim EmailCount As Integer 'The counter, which starts at zero.




Sheets("Merge Data").Select
'
' Initialize:
Set wb = ThisWorkbook
lngAuditRecord = 1 ' Start row
lngTotalRecords = 0
'
' Read email messages:
Application.ScreenUpdating = False
Set objOutlook = CreateObject("Outlook.Application")
Set objNSpace = objOutlook.GetNamespace("MAPI")
'
' Allow user to choose folder:#
Set objFolder = objNSpace.pickfolder






lngTotalItems = objFolder.Items.Count
MsgBox "Outlook folder contains " & lngTotalItems, vbOKOnly + vbCritical, "Error - Empty Folder" '''
If lngTotalItems = 0 Then
MsgBox "Outlook folder contains no email messages", vbOKOnly + vbCritical, "Error - Empty Folder"
End If




Set ws = ActiveSheet




'Insert Title Row and Format NOTE: THE MACRO CAN BE USED TO PARSE OUT OTHER PARTS OF AN EMAIL.
' I JUST COMMENTED OUT THE LINES NOT USED FOR THE CURRENT PROJECT.
ws.Cells(1, 1) = "Received"
ws.Cells(1, 2) = "Email Body"
'ws.Cells(lngAuditRecord, 3) = "Subject"
'ws.Cells(lngAuditRecord, 4) = "Attachments Count"
'ws.Cells(lngAuditRecord, 4) = "Sender Name"
'ws.Cells(lngAuditRecord, 5) = "Sender Email"
ws.Range(Cells(lngAuditRecord, 1), Cells(lngAuditRecord, 1)).Select
Selection.EntireRow.Font.Bold = True
Selection.HorizontalAlignment = xlCenter


'Populate the workbook
For lngCount = 1 To lngTotalItems
Application.StatusBar = "Reading message " & lngCount & " of " & lngTotalItems '''
i = 0
'read email info




While i < lngTotalItems
i = i + 1
If i Mod 50 = 0 Then Application.StatusBar = "Reading email messages " & Format(i / lngTotalItems, "0%") & "..."
With objFolder.Items(i)


Dim str As String
str = objFolder.Items(i).Body




MsgBox "Outlook folder contains " & str, vbOKOnly + vbCritical, "Error - Empty Folder" '''


Range("c" & i + 1).Value = str


'Cells(i + 1, 1).Formula = .ReceivedTime
'Cells(i + 1, 2).Formula = .Body
'Cells(i + 1, 3).Formula = .subject
'Cells(i + 1, 4).Formula = .Attachments.Count
'Cells(i + 1, 5).Formula = .SenderName
'Cells(i + 1, 6).Formula = .SenderEmailAddress
End With


Wend
'Set objFolder = Nothing
ws.Activate
Next lngCount
lngTotalRecords = lngCount


'Format Worksheet
Columns("C:C").Select
'Selection.ColumnWidth = 255
Cells.Select
Selection.Columns.AutoFit
Selection.Rows.AutoFit
With Selection
.VerticalAlignment = xlTop
End With
'Range("A1").Select








With Selection
Columns("C:C").Select ''
Cells.Select
.VerticalAlignment = xlTop
.WrapText = True
End With




End Sub

 

[egmg1988]

One more detail. I got the emails in an archive from google as an .mbox file.
Since Outlook doesn't open .mbox files, I opened the file with Thunderbird first, then saved all the emails as .eml so Outlook could open them.

Not sure if that could make a difference.

 

[gardnertoo]

I too would like to get something like this to work. You had commented out several field that I do want, so I resotred them to test. Still, your code gives me errors at the following places:

str = objFolder.Items(i).Body throws a "Method 'Body' of object '_MailItem' failed" error

When I comment out that line to get the code past it, the following lines all give me an "Application-defined or object-defined error"
Cells(i + 1, 2).Formula = .Body
Cells(i + 1, 5).Formula = .SenderName
Cells(i + 1, 6).Formula = .SenderEmailAddress


The "Received", "Subject", and "Attachements Count" all work, but the others don't. Syntax maybe? I hope a board member with more knowledge sees this and helps us out!

 

[gardnertoo]

In my case, it seems that the corporate IT people have locked down some fields, so Excel cannot reach in and grab the info. Your code works on Outlook installed on my home PC, but not Outlook installed at work. Oh, well.