Sunday, August 29, 2021

How to Search an Outlook Email Folder by using an Excel VBA Macro

One exciting aspect of using macros in Excel is that they can “talk” to other programs, like PowerPoint. One example I’ve shared is exporting data from Excel into Microsoft Word as the basis for writing a book. Another common use is exchanging information with Microsoft Outlook and writing emails from Excel. Previously, I showed how you can send emails from Excel. Today I want to show you a quick example how you can export email data from a folder in Outlook to Excel.

Let’s pretend you’ve saved emails every month with monthly expenses for your business in a folder called “01 Reports” in your Outlook email. You want to summarize the expenses in an Excel sheet without having to open and copy and paste every email in the folder. A macro in Excel written with VBA is the perfect solution for this scenario. Here’s how to do it.

 


First, setup the template. In cell A2 I am going to allow the user to write in the name of the folder they want to search through for the email reports to export to Excel. Then, we will place the email report date, email sender, and the expense cost into columns B, C, and D respectively. Once the template is setup, we can begin coding.

 


Create a new macro called “Search_Email_Folder.” Open the Visual Basic Editor (VBE). Go to Tools > references. In the object library, scroll down and Check the box of “MICROSOFT OUTLOOK 14.0 OBJECT LIBRARY” to make it available for Excel VBA.

 


Add a header to the top of the code that explains what the macro does. This macro loops through a specified folder in Outlook to export all the expense report data

Sub Search_Email_Folder()

On Error GoTo ErrHandler


  'Optimize Macro Speed

    Application.ScreenUpdating = False

    Application.EnableEvents = False

    Application.Calculation = xlCalculationManual

   

    Dim WS As Worksheet

    Set WS = Worksheets(1)

   

    'Find the last non-blank cell in column B and clear all the old data

    Dim lRow As Long

    lRow = Cells(Rows.Count, 2).End(xlUp).Row

    WS.Range("B2:G" & lRow).ClearContents

   

The Outlook object model provides all of the functionality necessary to manipulate data that is stored in Outlook folders, and it provides the ability to control many aspects of the Outlook user interface (UI). What is MAPI? Use GetNameSpace ("MAPI") to return the Outlook NameSpace object from the Application object. The only data source supported is MAPI, which allows access to all Outlook data stored in the user's mail stores. This is a “late binding” example. the following code sets an object variable to the Outlook Application object, which is the highest-level object in the Outlook object model. All Automation code must first define an Outlook Application object to be able to access any other Outlook objects. Most programming solutions interact with the data stored in Outlook. Outlook stores all of its information as items in folders. Folders are contained in one or more stores. After you set an object variable to the Outlook Application object, you will commonly set a NameSpace object to refer to MAPI, as shown in the following example.

 

        Dim objOutlook As Object

        Set objOutlook = CreateObject("Outlook.Application")

        Dim objNSpace As Object

        Set objNSpace = objOutlook.GetNamespace("MAPI")

        Dim myFolder As Object

        

        '---define the Outlook folder to search through. refers to cell so anyone can change the text without changing the macro code

        Dim EmailFolderToSearch As String

        EmailFolderToSearch = WS.Cells(2, 1) '—place name of folder in cell A2. must update if insert new columns before the first one

       

        'error handling if no folder specified

        If EmailFolderToSearch = "" Then

        MsgBox "No folder specificed."

        Exit Sub

        Else

        'proceed

        End If

       

        'MsgBox EmailFolderToSearch

        ‘the email folder to loop through is actually a sub folder of the Inbox

        Set myFolder = objNSpace.GetDefaultFolder(olFolderInbox).Folders(EmailFolderToSearch)

        Dim rcvDate As Date

        Dim iRows As Integer

        Dim objItem As Object

        Dim EmailSender As String

        Dim SenderEmailAddress As String

        Dim NumofReports As String

        Dim filID As Integer

        Dim DrwPost As Integer

              iRows = 2

             MsgBox "The number of emails found is: " & myFolder.Items.Count & " in " & myFolder.Name & " folder."

              'Loop through every email in outlook drawing folder

        For Each objItem In myFolder.Items

                   If objItem.Class = olMail Then

                Dim objMail As Outlook.MailItem

                Set objMail = objItem

 

                rcvDate = objMail.ReceivedTime

                EmailSender = objMail.SenderName

                SenderEmailAddress = objMail.SenderEmailAddress

               

                If Left(SenderEmailAddress, 3) = "/O=" Then

                    'internal gemail, skip, don't increase the row number

                                  Else

                ‘where to put the data in the Excel sheet:

                    WS.Cells(iRows, 2).Value = rcvDate

                    WS.Cells(iRows, 3).Value = EmailSender

                    WS.Cells(iRows, 4).Value = SenderEmailAddress

                   

                     'find the number of reports, information contained within the body of the email

                     filID = 0

                     DrwPost = 0

                mailBody = objMail.Body

 ‘search the email body for the word REPORTS

                filID = InStr(1, mailBody, "REPORTS", vbTextCompare)

              

                        If filID> 0 Then

                            DrwPost = filID + 6

                            NumofReports = Mid(mailBody, DrwPost, 15)

                            WS.Cells(iRows, 7).Value = NumofReports

                            Else

                            'number of reports not found

                        End If

                                           iRows = iRows + 1

                End If

                       End If

        Next

                  'Release

        Set objMail = Nothing

        Set objOutlook = Nothing

        Set objNSpace = Nothing

        Set myFolder = Nothing

   ErrHandler:

    Debug.Print Err.Description

          'Reset Macro Optimization Settings

        Application.EnableEvents = True

        Application.Calculation = xlCalculationAutomatic

        Application.ScreenUpdating = True

         MsgBox "Macro complete!"

 End Sub