Get outlook mail headers into excel using vba 1

[waynerenaud]

Hi,
From excel, I need to open outlook (2002), and copy all emails from the inbox for the previous month, into excel. If I do this manually, it automatically pastes the header only information into excel, (1 row per email) which is exactly what I want. I just need to know how to do it in vba.
Can anyone give me a starter to point me in the right direction. Thanks
(If only outlook had a record macros function)

 

[RobSchultz]

This should get you started (unless you digitally sign the script you will receive a warning when it is run)...

Option Explicit

Public Sub CopyHeadersToExcel(Optional ByVal excelFile As String = "C:\mail.xls")

    Dim oApp As Outlook.Application
    Dim oNS As Outlook.NameSpace
    Dim oF As MAPIFolder
    Dim oMI As Outlook.MailItem
    Dim oItem As Object
    Dim mailMonth As Integer
    Dim mailYear As Integer
    Dim oXLA As Excel.Application
    Dim oXLW As Excel.Workbook
    Dim oXLS As Excel.Worksheet
    Dim rowCount As Long
        
    If Month(Now) = 1 Then
        mailMonth = 12
        mailYear = Year(Now) - 1
    Else
        mailMonth = Month(Now) - 1
        mailYear = Year(Now)
    End If
        
    
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    Set oF = oNS.GetDefaultFolder(olFolderInbox)
    
    Set oXLA = New Excel.Application
    Set oXLW = oXLA.Workbooks.Add
    Set oXLS = oXLW.Worksheets.Add
    oXLS.Name = "Mail for " & mailMonth & "-" & mailYear
    
    For Each oItem In oF.Items
        DoEvents
        If Not oItem Is Nothing Then
            If oItem.Class = olMail Then
                Set oMI = oItem
                If Month(oMI.SentOn) = mailMonth And Year(oMI.SentOn) = mailYear Then
                    rowCount = rowCount + 1
                    oXLS.Range("A" & rowCount).Value = oMI.SentOn
                    oXLS.Range("B" & rowCount).Value = oMI.SenderName
                    oXLS.Range("C" & rowCount).Value = oMI.Subject
                End If
                Set oMI = Nothing
            End If
        End If
    Next oItem
    
    oXLW.Close True, excelFile
    oXLA.Quit
    
    Set oXLS = Nothing
    Set oXLW = Nothing
    Set oXLA = Nothing
    Set oMI = Nothing
    Set oItem = Nothing
    Set oF = Nothing
    Set oNS = Nothing
    Set oApp = Nothing
    
    Call MsgBox("Finished exporting mail to " & excelFile, vbOKOnly + vbInformation, "Finished!")

End Sub

HtH,

Rob

-Focus on the solution to the problem, not the obstacles in the way.-

 

[waynerenaud]

Hey Rob, I really appreciate the time you have taken to help me.
I tried pasting your code into a module in excel, and ran from a button on a worksheet
Sub test()
Module1.CopyHeadersToExcel
End Sub
It errored at the first dim statement saying Compile Error user-defined type not defined.
So I then copied it into a module in outlook and ran it. It then errored on the line Dim oXLA As Excel.Application with the same error, Compile Error user-defined type not defined.

I am guessing that I am running this incorrectly (especially as I didnt understad what you meant about signing the script)

How should I be running this, and do I need to add any references in excel for it to run.
Thanks again for all the help, it really is appreciated.
Wayne

 

[PHV]

If in Excel, add references to Outlook.
If in Outlook, add references to Excel.

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[waynerenaud]

Thanks PH, I added the references and it worked like a charm.
Rob you get a well deserved star.

One last question
In Outlook, I view 2 mailboxes, one is my normal inbox, the other uses the inbox in a mailbox called helpdesk_mb to store voicemails from our phone system.
I need to pull the headers form the helpdesk_mb inbox, not my default inbox.
How can I change your code to do this ??
Thanks again

 

[PHV]

You may browse the Folders collection with the GetFirst and GetNext method, testing the Name property of each folder.

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884