Excel VBA for searching in mails of Outlook

email, excel, outlook, vba

Solution

You cannot use Body in Find(Filter), see Items.Find Method (Outlook), as a Workaround, you can use VBA string search function:

Sub sofWorkWithOutlook20082550()
  Dim outlookApp
  Dim olNs As Outlook.Namespace
  Dim Fldr As Outlook.MAPIFolder
  Dim olMail As Variant
  Dim myTasks
  Dim sir() As String

  'Set outlookApp = New Outlook.Application
  Set outlookApp = CreateObject("Outlook.Application")

  Set olNs = outlookApp.GetNamespace("MAPI")
  Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
  Set myTasks = Fldr.Items

  '
  'Set olMail = myTasks.Find("[Subject] = ""123456""")
  '
  For Each olMail In myTasks
  '
    If (InStr(1, olMail.Body, "My-Text-to-Search", vbTextCompare) > 0) Then
      olMail.Display
      Exit For
    End If
  Next

End Sub

Problem

I'm working on a project where I have a list of Account IDs, and what I'm trying to do is to create a macro that will interface with Outlook, search my Inbox for any email with an specific criteria, and then return "Y" or "N" if it was found, and if it was found, who the email was sent from and the time it was sent. Below is the code I'm using; I need the macro to search the Body of the Email instead of the Subject Line. When I substitute [Subject] for [Body], the macro runs without errors, but returns no emails (I place a couple test emails for it to catch). I am running Excel and Outlook 2007, and have already reference the MS 12.0 Excel & Outlook libraries in VBA. ``` Sub Work_with_Outlook() Set outlookApp = CreateObject("Outlook.Application") Dim olNs As Outlook.Namespace Dim Fldr As Outlook.MAPIFolder Dim olMail As Variant Dim sir() As String Set outlookApp = New Outlook.Application Set olNs = outlookApp.GetNamespace("MAPI") Set Fldr = olNs.GetDefaultFolder(olFolderInbox) Set myTasks = Fldr.Items Set olMail = myTasks.Find("[Subject] = ""123456""") If Not (olMail Is Nothing) Then olMail.Display End If End Sub ```

Original source