Share via


Searching Messages in Microsoft Outlook by their Subjects

One of the forum users had a problem with the Windows Search 4.0 mechanism in Microsoft Outlook, which displayed an excessive number of messages when searching for a specified subject.

Inserting the desired content between apostrophes, as presented below, is an answer to this problem (Fig.1.).

http://outlook-center.com/article/upload/295.png
Fig. 1. Detailed search.

An  alternative solution is a VBA code, which browses through a selected folder for e-mails with specified body content. The macro below presents two methods of searching:

  • Detailed  - where the entered content in the search field must fit exactly (ignoring capital letters),
  • Fragmentary – where the content must be located in the field being searched (in this case it’s the Subject field).

Both methods are interconnected, so if one method doesn't return any results, another one is suggested. Below you will find the macro procedure for searching by a message subject.

Option Explicit
Dim search$, search_more As Object, iFolder$
Dim oFolder As MAPIFolder, oMail As MailItem, x&

Sub search_message_by_subject()
'MVP OShon from VBATools.pl 
iFolder = Application.ActiveExplorer.CurrentFolder
    search = InputBox("Specify the subject of e-mail In this folder " & Chr(34) & _
    iFolder & Chr(34) & vbCr & vbCr & "Not case sensitive.", _
    "Detailed content search - O'Shon VBATools.pl")
    If FindSubjExact(search) = False Then search_more = MsgBox("No messages with the specified subject " & search & _
    "." & vbCr & "Do you want to search an e-mail with the specified word in the subject?", _
    vbExclamation + vbDefaultButton2 + vbYesNo, "MVP OShon from VBATools.pl")
    If search_more = vbYes Then
        If FindSubjPart(search) = False Then MsgBox("Sorry, no message with the content " & search & _
        " in folder " & Chr(34) & iFolder & Chr(34), vbExclamation, "Fragmentary search - O'Shon VBATools.pl")
    End If
End Sub

Private Function FindSubjExact(ByVal content$) As Boolean
    content = """" & content & """"
    oFolder = Application.ActiveExplorer.CurrentFolder
    oMail = oFolder.Items.Find("[Subject]=" & content & "")

    FindSubjExact = False
    While Not oMail Is Nothing
        DoEvents()
        oMail.Display(0)
        FindSubjExact = True
        oMail = oFolder.Items.FindNext()
    End While
    oFolder = Nothing
    oMail = Nothing
End Function

Private Function FindSubjPart(ByVal content$) As Boolean
    If Len(Replace(content, Chr(34), vbNullString)) = 0 Then FindSubjPart = True : Exit Function
    oFolder = Application.ActiveExplorer.CurrentFolder

    FindSubjPart = False
    For x = 1 To oFolder.Items.Count
        If oFolder.Items(x).Class = 43 Then
            oMail = oFolder.Items(x)
            DoEvents()
            If InStr(1, UCase(oMail.Subject), UCase(content)) > 0 Then
                oMail.Display(0)
                FindSubjPart = True
            End If
        End If
    Next x

    oFolder = Nothing
    oMail = Nothing
End Function

If you are not experienced in macro installation in Microsoft Outlook, please refer to the article Installation and running macros.


 (c) Shon Oskar 
© All rights reserved. No part or whole of this article may not be reproduced or published without prior permission.
Oryginal article publicate at this page


See Also