Exporting MS Outlook Mail to Excel

[RhinoNeil]

I have been trying to create a macro that exports basic info out of MS Outlook 2007 but I am struggling. I have patched together the following code from various forum posts so that all the Mail basic info contained in 3 Public Folders plus subfolders are transferred to a csv file (I wanted Excel but couldn't get it to work).

It pulls some of the mail messages but not all (e.g. for one subfolder it pulls 2,952 out of 4,932 Mail messages). Only Mail messages are contained in all folders, i.e. no Meeting requests, Tasks etc and I couldn't spot any pattern to the Mail which were or were not transfered to the csv file.

Can anybody please tell me why the code doesn't pull all Mail messages from the Subfolders are give me some noew code which works, note I have very limited vba knowldge.

Thanks.

Public strFolder(20) As String
Public x As Integer

Sub TestSaveItemsToExcel()
Dim dte_Start As Date
Dim dte_Stop As Date
Dim oNameSpace As Outlook.NameSpace
Dim oFolder As Outlook.MAPIFolder
'You must set a reference to the Microsoft Scripting Runtime library to use the FileSystemObject
Dim objFS As Scripting.FileSystemObject
Dim objOutputFile As Scripting.TextStream
dte_Start = Now()
strFolder(1) = "Mailbox - A"
strFolder(2) = "Mailbox - B"
strFolder(3) = "Mailbox - C"
Set objFS = New Scripting.FileSystemObject
Set objOutputFile = objFS.OpenTextFile("C:\Export\Export.csv", ForWriting, True)
Set oNameSpace = Application.GetNamespace("MAPI")

'Write header line
objOutputFile.WriteLine "Received,Parent,Importance,Unread,ReceivedByName,SenderName,Attachments,Subject"

x = 1

'=============================================================================================================
Do Until strFolder(x) = ""
    Set oFolder = oNameSpace.Folders(strFolder(x))
    
    If oFolder Is Nothing Then
     MsgBox "Folder not valid"
     GoTo ErrorHandlerExit
    End If
    
    
     ' Check if folder can contain Mail Items
     If oFolder.DefaultItemType <> olMailItem Then
         MsgBox "Folder does not contain mail messages"
         GoTo ErrorHandlerExit
     End If
    
     ProcessFolderItems oFolder, objOutputFile
 
x = x + 1
Loop
' =============================================================================================================
objOutputFile.Close
Set oFolder = Nothing
Set oNameSpace = Nothing
Set objOutputFile = Nothing
Set objFS = Nothing
dte_Stop = Now()
MsgBox "Completed in " & DateDiff("n", dte_Start, dte_Stop) & " Minutes"
ErrorHandlerExit:
Exit Sub

End Sub

Sub ProcessFolderItems(oParentFolder As Outlook.MAPIFolder, ByRef objOutputFile As Scripting.TextStream)
On Error Resume Next
Dim oCount As Integer
Dim oMail As Outlook.MailItem
Dim oFolder As Outlook.MAPIFolder
Dim x As Integer
oCount = oParentFolder.Items.Count

For Each oMail In oParentFolder.Items
    If oMail.Class = olMail Then
            objOutputFile.WriteLine oMail.ReceivedTime & "," & oMail.Parent & "," & oMail.Importance & "," & oMail.UnRead & "," & oMail.ReceivedByName & "," & oMail.SenderName & "," & oMail.Attachments.Count & "," & oMail.Subject
    End If
Next oMail
Set oMail = Nothing
'check to see if we have an child folders
If (oParentFolder.Folders.Count > 0) Then
    For Each oFolder In oParentFolder.Folders
        ProcessFolderItems oFolder, objOutputFile
    Next
End If
    
End Sub