Searching Outlook email (and replying to it) using Excel VBA

Question

I want to search ALL my outlook for latest message in a conversation (I use Subject name as search key).

This latest message can be in Inbox, Sent Items, in a sub folder of Inbox, a sub-sub folder of Inbox (anywhere).

I can achieve this by some very tedious code, going through every level of each major folder, but not only this method is very messy, I can't determine if this found message is the latest in this conversation.

I have the following code, which

--> Searches Inbox for "searchKey"

--> If finds it in Inbox folder, replies to it

--> If not, it moves into subfolders of Inbox, and continues the same process

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olFldr As MAPIFolder
Dim olMail ' As Outlook.MailItem
Dim i As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set olFldr = Fldr

tryAgain:

    For Each olMail In olFldr.Items
        If InStr(olMail.Subject, searchKey) <> 0 Then
            Set ReplyAll = olMail.ReplyAll
            With ReplyAll
                .HTMLBody = Msg & .HTMLBody
                emailReady = True
                .Display
            End With
        End If
    Next olMail


If Not emailReady Then
    i = i + 1
    If i > Fldr.Folders.Count Then
        MsgBox ("The email with the given subject line was not found!")
        Exit Sub
    Else
        Set olFldr = Fldr.Folders(i)
        GoTo tryAgain
    End If
End If

This code might be confusing and long, so please let me know if you need any clarification.

The question is: How can I search through ALL Outlook, without going manually through every folder/subfolder/sub-subfolder... without this method, and find the LAST message in a specific conversation? Or, at least, how can I optimize this code so I don't miss any folder, and know the dates and times these emails were sent?

Answer 1

You can use the built in AdvancedSearch function, which returns a Search object containing items. These should have date properties, so you only need your code to go through the search object mailItems and find that with the latest date ( ReceivedTime)?

I would suggest using the bottom example on that page - it gets a table object from the search, and then you use

Set MyTable = MySearch.GetTable  
Do Until MyTable.EndOfTable  
    Set nextRow = MyTable.GetNextRow()  
    Debug.Print nextRow("ReceivedTime")  
Loop

From there, you can do the comparison to find the latest time, and if you want to do something with the mailitem you would need to obtain the "EntryID" column from the table. Then use the GetItemFromID method of the NameSpace object to obtain a full item, since the table returns readonly objects.

You can also apply a date filter to the search if you wish, if you knew a minimum date for instance.

Answer 2

To go through all folders do this: Go once through all the primary folders in Outlook and then for each major folder go through each subfolder. If you have more branches then is guess you have to add more levels to the code "for each Folder3 in folder2.folders". Also in the if clause you can test the date of the mail and go from the newest to the oldest. Set oMsg.display to see what mail is being checked

Public Sub FORWARD_Mail_STAT_IN()
Dim Session As Outlook.NameSpace
Dim oOutLookObject As New Outlook.Application
Dim olNameSpace As NameSpace
Dim oItem As Object
Dim oMsg As Object
Dim searchkey As String

Set oOutLookObject = CreateObject("Outlook.Application")
Set oItem = oOutLookObject.CreateItem(0)
Set olNameSpace = oOutLookObject.GetNamespace("MAPI")

Set Session = Application.Session
Set Folders = Session.Folders
For Each Folder In Folders  'main folders in Outlook

        xxx = Folder.Name
           For Each Folder2 In Folder.Folders  'all the subfolders from a main folder
            yyy = Folder2.Name
             Set oFolder = olNameSpace.Folders(xxx).Folders(yyy)  'in each folder we search all the emails

              For Z = oFolder.Items.Count To 1 Step -1 ' For Z = 1 To oFolder.Items.Count
                  With oFolder.Items(Z)
                   Set oMsg = oFolder.Items(Z)

                    If Format(oMsg.SentOn, "mm/dd/yyyy") = Format(Date, "mm/dd/yyyy") And InStr(1, LCase(oMsg.Subject), searchkey, vbTextCompare) > 0 Then 
oMsg.display
                        '  insert code
                        End If
                      End With
                  Next Z
           Next Folder2
        Next Folder