Search a specific Outlook folder from Excel and retrieve the date of most recent match

Question

I've got an Outlook folder with saved mails, each containing a list of tickers. I want to be able to search for a ticker and get the date of the most recent mail containing that specific ticker. I did try searching for solutions online such as the one here Excel VBA for searching in mails of Outlook , but I've been unable to find something which suits my needs.

Answer 1

Try this user defined function that I've written for you. Add this code to a module in excel then use it as a normal function in Excel. You can input the ticker name directly into the function in text quotes, e.g. =FindTicker("ABC"), or you can reference another cell that has the ticker value, e.g. FindTicker(A1)

I'm assuming you've saved the emails to a subfolder of your inbox. In the code, replace "Subfolder name" with the name of your subfolder (still in double quotes). If the emails haven't been moved from your inbox, then remove that line entirely.

For this to work, you need to add a reference to the Microsoft Outlook Reference Library.

This function will only operate in the workbook where you add the code, unless you save the workbook as an add-in and then install it, in which case the function will be available in any workbook.

Public Function FindTicker(strTicker As String) As Variant

Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olFolderItems As Outlook.Items
Dim olMail As Outlook.MailItem

'Open outlook if it's not open, otherwise connect to open instance
If Outlook.Application.Explorers.Count = 0 Then
    Set olApp = CreateObject("Outlook.Application")
Else
    Set olApp = Outlook.Application
End If

'Get emails to search through
Set olNamespace = olApp.GetNamespace("MAPI")
Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("Subfolder name") 'UPDATE/REMOVE THIS LINE
Set olFolderItems = olFolder.Items

'Set default value if not found
FindTicker = "Ticker not found"

'Search through bodies of emails for ticker value
For Each olMail In olFolderItems
    If (InStr(1, olMail.Body, strTicker, vbTextCompare) > 0) Then
        FindTicker = Format(olMail.SentOn, "dd/mm/yyyy")
        Exit For
    End If
Next

'Clear object variables
Set olApp = Nothing
Set olNamespace = Nothing
Set olFolder = Nothing
Set olFolderItems = Nothing
Set olMail = Nothing

End Function