Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Using VBA + Outlook to get content of emails 1

Status
Not open for further replies.

plmnb

Programmer
Joined
Apr 9, 2004
Messages
6
Location
GB
Hi,

Using VBA in Outlook 2000, how to get the content of all emails in folder Inbox?
 
Not sure if this will help. I came across this somewhere on the web, I don't remember where to give them credit. I'm sure with some modification it will do what you want.

Code:
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) = 4 Then
        mailMonth = 4
        mailYear = Year(Now)
    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
                    oXLS.Range("D" & rowCount).Value = oMI.Body
                    
                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
 
Thank you. That helps!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top