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