An Excel & Outlook Hack

Last week, one of my workmates asked me if I could construct an Excel solution to automate a particularly tedious task he had to perform on a daily basis. The task involved opening emails, copying the senders, editing them, and searching for them in Workbooks. If the searches failed, the emails would be flagged as unread and the procedure repeated, ad nauseum. The idea was to ensure that all the senders were found in the Workbooks.

As an Excel VBA hacker, the only part that was not immediately apparent to me was the method to access the non-default Outlook mailbox in which my workmate was receiving the emails, which totaled around 2/3 hundreds a day. After a few google searches, I found the workaround and managed to construct an Excel add-in that now helps my workmate perform the task with a few clicks.

The first step was to add the Outlook object code library from the Excel VBA IDE by clicking Tools > References, and then ticking Microsoft Outlook 11.0 Object Library and clicking Ok on the dialogue box. Next, the following procedure was created.

Option Explicit

Sub mainProc()

    Application.ScreenUpdating = False

    '//////////////////////////////////////////////
    ' declare the vars
    '//////////////////////////////////////////////

    Dim Sh As Worksheet
    Dim Olapp As Object
    Dim Olns As Namespace
    Dim Fldr As MAPIFolder
    Dim OlMail As Variant
    Dim intFinalRow As Integer
    Dim i, j, k As Integer
    Dim intProgCent As Integer
    Dim intTotMails As Integer
    Dim strFolderId As String

    On Error GoTo Err_Rtn:

    strFolderId = "xxx"

    Set Sh = ActiveSheet
    Set Olapp = New Outlook.Application
    Set Olns = Olapp.GetNamespace("MAPI")
    Set Fldr = Olns.GetFolderFromID(strFolderId)
    intTotMails = Fldr.Items.Count
    j = 0
    k = 0
    frmProgressBar.Show

    intFinalRow = Sh.Range("F65536").End(xlUp).Row

    For Each OlMail In Fldr.Items
        j = j + 1
        intProgCent = (j / intTotMails) * 100
        With frmProgressBar
            .ProgressBar1.Value = intProgCent
            .lblPercent = Str(intProgCent) & "%"
        End With

    If OlMail.UnRead = True Then
        For i = 1 To intFinalRow
            With Sh
                If Trim(.Range("F" & i).Value) = _
                                Right(Trim(OlMail.SenderName), 9) Then
                    .Range("A" & i & ":K" & i).Interior.ColorIndex = 17
                    OlMail.UnRead = False
                    k = k + 1
                    Exit For
                End If
            End With
        Next i
    End If
    DoEvents
    Next OlMail
    Unload frmProgressBar
    MsgBox "Total found " & k
    Set Fldr = Nothing
    Set Olns = Nothing
    Set Olapp = Nothing
    Set Sh = Nothing
    Application.ScreenUpdating = True
    Exit Sub
Err_Rtn:
    Unload frmProgressBar
    Application.ScreenUpdating = True
    MsgBox Err.Description
End Sub

The code is self-explanatory. It loops through all the emails in the folder with id equal to the value of strFolderId. If an email is not already read, the nine rightmost characters of the sender name are extracted with the inbuilt VBA function Right() and compared with the values in the 'F' column of the active worksheet. If a match is found, the color of the row of the matched value is changed and the email flagged as read. If no match is found, the code interrogates the next email.

There is also a progress bar and a pop-up dialogue box that displays the total number of matches found at the end of the program execution.

Only one thing needs a bit more explanation. The variable strFolderId is set to "xxx" in line 24. In fact, the value is a long string that is found by running the following macro in Outlook.

Option Explicit

Sub findFolderId()
    Dim Ons As Outlook.NameSpace
    Dim Fldr As Outlook.MAPIFolder
    On Error Resume Next
    
    Set Ons = Application.GetNamespace("MAPI")
    Set Fldr = Ons.PickFolder
    Debug.Print Fldr.StoreID
    Set Ons = Nothing
    Fldr = Nothing
    On Error GoTo 0
End Sub

The folder id will be displayed in the Immediate window.

One final note. Since this code implements 'early binding' after manually adding the reference to the Outlook object code library, the application will fail to work if/when the object library is upgraded, as might happen when a newer version of MS Office suite is installed. To preempt this issue, the code should be changed to use 'late binding'. In some future post, that is what I might do.