cramocairyk
New Member
- Outlook version
- Outlook 2016 64 bit
- Email Account
- Exchange Server
I can't tell you how frustrated I was that Microsoft disabled the Windows Search feature in Outlook 2016 !
The ability to perform a single search in all of my 200+ public folders (and in my Inbox), with the aggregate results being displayed in a single window, was invaluable !
This is my first attempt at restoring that functionality in Outlook 2016 (tested with Office 365 ProPlus on 64-bit Windows 7).
Although the search results for the Inbox (and its sub-folders) all appear in the same results window, I wasn't able to find a way to get the search results from Public sub-folders to aggregate into a single results window, so the macro below creates a separate search results window for each Public sub-folder having e-mails that satisfy your search criterion.
Don't panic if it takes a long (long !) time for the results windows to start appearing ! The search operations (apparently) take precedence over window management, so the nested folder searches will all complete before any of the windows will start to appear (with the possible exception of the search results window for the Inbox and its sub-folders)
I can't take credit for *everything* you see below - I borrowed bits and pieces of it from the best on the 'net ! Many thanks to those who took the time to post their samples !
Good luck with it ... feel free to let me know what you think of it, but I make no promises of proper support !
BTW, this macro will try to find a View called "Search Results" - if it exists, it will use that View to control the format of each results window, otherwise it will default to the View that was currently selected in the active Outlook window prior to running the macro. So if you want to customize the look and feel of the result windows, just create a view by that name and tailor it to your liking, then perform your search.
The ability to perform a single search in all of my 200+ public folders (and in my Inbox), with the aggregate results being displayed in a single window, was invaluable !
This is my first attempt at restoring that functionality in Outlook 2016 (tested with Office 365 ProPlus on 64-bit Windows 7).
Although the search results for the Inbox (and its sub-folders) all appear in the same results window, I wasn't able to find a way to get the search results from Public sub-folders to aggregate into a single results window, so the macro below creates a separate search results window for each Public sub-folder having e-mails that satisfy your search criterion.
Don't panic if it takes a long (long !) time for the results windows to start appearing ! The search operations (apparently) take precedence over window management, so the nested folder searches will all complete before any of the windows will start to appear (with the possible exception of the search results window for the Inbox and its sub-folders)
I can't take credit for *everything* you see below - I borrowed bits and pieces of it from the best on the 'net ! Many thanks to those who took the time to post their samples !
Good luck with it ... feel free to let me know what you think of it, but I make no promises of proper support !
BTW, this macro will try to find a View called "Search Results" - if it exists, it will use that View to control the format of each results window, otherwise it will default to the View that was currently selected in the active Outlook window prior to running the macro. So if you want to customize the look and feel of the result windows, just create a view by that name and tailor it to your liking, then perform your search.
Code:
Private Sub RecursiveFolderSearch(ByRef objParentFolder As Outlook.MAPIFolder, ByVal strViewName As String, ByVal strDASLFilter As String)
On Error GoTo Err_SearchFolder
'
' If folder has items other than just sub-folders
'
If objParentFolder.Items.Count Then
'
' Search this sub-folder
'
Dim strScope As String
'strScope = "'Inbox'" ' works but Results.Count is 0 -> results can only be saved
'strScope = "'Inbox','Sent Items'" ' works but Results.Count is 0 -> results can only be saved
'strScope = "'" & objMyPublicFolder.FolderPath & "'" ' works and Results.Count <> 0 -> but results cannot be saved
'strScope = "'Inbox','" & objMyPublicFolder.FolderPath & "'" ' doesn't work
'strScope = "'" & objMyPublicFolder.FolderPath & "','" & objMyPublicFolderToo.FolderPath & "'" ' doesn't work
strScope = "'" & objParentFolder.FolderPath & "'"
Dim objSearch As Search
Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, SearchSubFolders:=False, Tag:="SearchFolder")
If objSearch.Results.Count Then
'
' Display the results in a separate Outlook Explorer window
'
Dim objExplorer As Outlook.Explorer
Set objExplorer = Application.Explorers.Add(objParentFolder, olFolderDisplayNormal)
Call objExplorer.Display
Dim objCurrentView As Outlook.View
Set objCurrentView = objExplorer.CurrentFolder.Views.Item("Search Results")
If objCurrentView Is Nothing Then
Set objCurrentView = objExplorer.CurrentFolder.Views.Item(strViewName)
End If
objCurrentView.Filter = strDASLFilter
On Error GoTo Err_Ignore
objCurrentView.Apply
Err_Ignore:
On Error GoTo Err_SearchFolder
Set objCurrentView = Nothing
Set objExplorer = Nothing
End If
Set objSearch = Nothing
End If
'
' Recurse through sub-folders
'
Dim objFolder As Outlook.MAPIFolder
For Each objFolder In objParentFolder.Folders
Call RecursiveFolderSearch(objFolder, strViewName, strDASLFilter)
Next
Set objFolder = Nothing
Exit Sub
Err_SearchFolder:
MsgBox "Error # " & Err & " : " & Error(Err)
End Sub
Public Sub SearchInAllFolders()
On Error GoTo Err_SearchFolder
'
' Collect information
'
Dim objApplication As Outlook.Application
Set objApplication = CreateObject("Outlook.Application")
Dim objNamespace As Outlook.NameSpace
Set objNamespace = objApplication.GetNamespace("MAPI")
Dim strViewName As String
strViewName = Application.ActiveExplorer.CurrentView.Name
Dim Account As String
Account = objNamespace.Accounts(1).SmtpAddress
'
' Input search string
'
Dim strFilter As String
strFilter = InputBox("Enter Search String:", "Search in all files")
If strFilter = "" Then
Exit Sub
End If
Dim strDASLFilter As String
strDASLFilter = """urn:schemas:httpmail:fromname"" LIKE '%" & strFilter & "%' " + _
"OR ""urn:schemas:httpmail:textdescription"" LIKE '%" & strFilter & "%' " + _
"OR ""urn:schemas:httpmail:displaycc"" LIKE '%" & strFilter & "%' " + _
"OR ""urn:schemas:httpmail:displayto"" LIKE '%" & strFilter & "%' " + _
"OR ""urn:schemas:httpmail:subject"" LIKE '%" & strFilter & "%' " + _
"OR ""urn:schemas:httpmail:thread-topic"" LIKE '%" & strFilter & "%' " + _
"OR ""http://schemas.microsoft.com/mapi/received_by_name"" LIKE '%" & strFilter & "%' " + _
"OR ""http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8586001f"" LIKE '%" & strFilter & "%' " + _
"OR ""http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/85a4001f"" LIKE '%" & strFilter & "%' " + _
"OR ""http://schemas.microsoft.com/mapi/id/{00062041-0000-0000-C000-000000000046}/8904001f"" LIKE '%" & strFilter & "%' " + "OR ""http://schemas.microsoft.com/mapi/proptag/0x0e03001f"" LIKE '%" & strFilter & "%' " + _
"OR ""http://schemas.microsoft.com/mapi/proptag/0x0e04001f"" LIKE '%" & strFilter & "%' " + _
"OR ""http://schemas.microsoft.com/mapi/proptag/0x0042001f"" LIKE '%" & strFilter & "%' " + "OR ""http://schemas.microsoft.com/mapi/proptag/0x0044001f"" LIKE '%" & strFilter & "%' " + _
"OR ""http://schemas.microsoft.com/mapi/proptag/0x0065001f"" LIKE '%" & strFilter & "%' "
'
' Search Inbox and its sub-folders
'
Dim strScope As String
strScope = "Inbox"
Dim objSearch As Search
Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")
'
' Save the search results to a SearchFolder
'
objSearch.Save (strFilter)
Set objSearch = Nothing
'
' Display the SearchFolder in a separate Outlook Explorer window
'
Dim objStore As Outlook.Store
Set objStore = Application.Session.Stores.Item(Account)
If objStore Is Nothing Then GoTo SearchPublicFolders
Dim objSearchFolders As Outlook.Folders
Set objSearchFolders = objStore.GetSearchFolders
If objSearchFolders Is Nothing Then GoTo SearchPublicFolders
Dim objSearchFolder As Outlook.Folder
Set objSearchFolder = objSearchFolders.Item(strFilter)
If objSearchFolder Is Nothing Then GoTo SearchPublicFolders
Dim objExplorer As Outlook.Explorer
Set objExplorer = Application.Explorers.Add(objSearchFolder, olFolderDisplayNormal)
Call objExplorer.Display
Dim objCurrentView As Outlook.View
Set objCurrentView = objExplorer.CurrentFolder.Views.Item("Search Results")
If objCurrentView Is Nothing Then
Set objCurrentView = objExplorer.CurrentFolder.Views.Item(strViewName)
End If
On Error GoTo Err_Ignore
objCurrentView.Apply
Err_Ignore:
On Error GoTo Err_SearchFolder
'
' Search Public folder 'Favorites' and its sub-folders
'
SearchPublicFolders:
Dim objPublicFolders As Outlook.MAPIFolder
Set objPublicFolders = objNamespace.Folders("Public Folders - " & Account)
Dim objFavoritesFolder As Outlook.MAPIFolder
Set objFavoritesFolder = objPublicFolders.Folders("Favorites")
Call RecursiveFolderSearch(objFavoritesFolder, strViewName, strDASLFilter)
GoTo Cleanup
Err_SearchFolder:
MsgBox "Error # " & Err & " : " & Error(Err)
Cleanup:
Set objFavoritesFolder = Nothing
Set objPublicFolders = Nothing
Set objCurrentView = Nothing
Set objExplorer = Nothing
Set objSearchFolder = Nothing
Set objSearchFolders = Nothing
Set objStore = Nothing
Set objSearch = Nothing
Set objNamespace = Nothing
Set objApplication = Nothing
End Sub