Search Outlook folders

josros60

Well-known Member
Joined
Jun 27, 2010
Messages
786
Office Version
  1. 365
Hi,

found this code below how can it be modified to search for all folders/sub folders

Code:
Public Sub OutlookSearch()

Dim strFilter As String
Dim oMail As Outlook.MailItem
Dim strDASLFilter As String
Dim strScope As String


SendKeys "{HOME}", True
On Error GoTo Err_SearchFolderForSender
 
strFilter = InputBox("Enter Search String:", "Search")
If strFilter = "" Then
    Exit Sub
End If
 
' lets get the email address from a selected message
Set oMail = ActiveExplorer.Selection.Item(1)
If strFilter = "" Then Exit Sub
 
' From email address
Const From1 As String = "http://schemas.microsoft.com/mapi/proptag/0x0065001f"
Const From2 As String = "http://schemas.microsoft.com/mapi/proptag/0x0042001f"
 
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 & "%' "
  
strScope = "Inbox"
 
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
 
Exit Sub
 
Err_SearchFolderForSender:
MsgBox "Error # " & Err & " : " & Error(Err)
 
End Sub

thanks
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Replace the strScope = "Inbox" line with these lines:
Code:
    Dim accountFolder As Folder, topFolder As Folder
    Dim allTopFolders As String
    
    allTopFolders = ""
    For Each accountFolder In Session.Folders
        For Each topFolder In accountFolder.Folders
            allTopFolders = allTopFolders & "'" & topFolder.Name & "',"
        Next
    Next
    strScope = Left(allTopFolders, Len(allTopFolders) - 1)
strScope is then a list of all the top-level folders in every account.
 
Upvote 0
thank you for the reply.

I did but when click search and type the word looking for i get the following error:

Error # 2147352567: Array index out of bounds

Here is the complete code with your suggestion:

Code:
Public Sub NavigataAPSearch()Dim strFilter As String
Dim oMail As Outlook.MailItem
Dim strDASLFilter As String
Dim strScope As String
Dim accountFolder As Folder, topFolder As Folder
Dim allTopFolders As String


SendKeys "{HOME}", True
On Error GoTo Err_SearchFolderForSender
 
strFilter = InputBox("Enter Search String:", "Search")
If strFilter = "" Then
    Exit Sub
End If
 
' lets get the email address from a selected message
Set oMail = ActiveExplorer.Selection.Item(1)
If strFilter = "" Then Exit Sub
 
' From email address
Const From1 As String = "http://schemas.microsoft.com/mapi/proptag/0x0065001f"
Const From2 As String = "http://schemas.microsoft.com/mapi/proptag/0x0042001f"
 
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 & "%' "
  
'strScope = "Navigata AP"


 allTopFolders = ""
    For Each accountFolder In Session.Folders
        For Each topFolder In accountFolder.Folders
            allTopFolders = allTopFolders & "'" & topFolder.Name & "',"
        Next
    Next
    strScope = Left(allTopFolders, Len(allTopFolders) - 1)
 
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
 
Exit Sub
 
Err_SearchFolderForSender:
MsgBox "Error # " & Err & " : " & Error(Err)
 
End Sub
 
Upvote 0
Comment out the On Error GoTo line and rerun the macro. Click the Debug button when the error message appears - which line is highlighted in yellow?
 
Upvote 0
tried what happened it give a different error pop up message will not let run debug unless i click OK the error.

now giving me different error # 2147024809: Sorry, something went wrong. You may want to try again.
 
Upvote 0
Do you have multiple accounts in your Outlook? If so, then the code I suggested is wrong because it creates the strScope string containing the top-level folders for all the accounts and you'll get that 'Sorry, something went wrong' error, because AdvancedSearch is trying to search all the accounts at once.

The solution is to run AdvancedSearch separately on each account, creating strScope as the list of top-level folders for each account:

Code:
Public Sub Outlook_AdvancedSearch_All_Accounts()

    Dim strFilter As String
    Dim strDASLFilter As String
    Dim strScope As String
    Dim accountFolder As Folder, topFolder As Folder
    Dim allTopFolders As String
    Dim objSearch As Search
    
    'On Error GoTo Err_SearchFolderForSender
     
    strFilter = InputBox("Enter Search String:", "Search")
    If strFilter = "" Then Exit Sub
          
    ' From email address
    Const From1 As String = "http://schemas.microsoft.com/mapi/proptag/0x0065001f"
    Const From2 As String = "http://schemas.microsoft.com/mapi/proptag/0x0042001f"
     
    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 & "%' "
      
    'Run Advanced Search on all top-level folders in each account
    
    For Each accountFolder In Session.Folders
    
        'Create list of top-level folders in this account
        
        allTopFolders = ""
        For Each topFolder In accountFolder.Folders
            allTopFolders = allTopFolders & "'" & topFolder.Name & "',"
        Next
        strScope = Left(allTopFolders, Len(allTopFolders) - 1)
        
        Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")
        
        'Save the search results in a folder inside Search Folders in the Outlook UI
        
        objSearch.Save strFilter
        
        Set objSearch = Nothing
    
    Next

    Exit Sub
     
Err_SearchFolderForSender:
    MsgBox "Error # " & Err & " : " & Error(Err)
 
End Sub
If you still get an error on the AdvancedSearch for multiple accounts with the above macro then try this macro which searches only a single specific account.

The account to search is this line:

Code:
    Set accountFolder = Session.Folders(1)  'or Session.Folders("Account Name")
where you can specify the account by index number or name.

Code:
Public Sub Outlook_AdvancedSearch_Specific_Account()

    Dim strFilter As String
    Dim strDASLFilter As String
    Dim strScope As String
    Dim accountFolder As Folder, topFolder As Folder
    Dim allTopFolders As String
    Dim objSearch As Search
    
    'On Error GoTo Err_SearchFolderForSender
     
    strFilter = InputBox("Enter Search String:", "Search")
    If strFilter = "" Then Exit Sub
          
    ' From email address
    Const From1 As String = "http://schemas.microsoft.com/mapi/proptag/0x0065001f"
    Const From2 As String = "http://schemas.microsoft.com/mapi/proptag/0x0042001f"
     
    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 & "%' "
      
    'Run Advanced Search on all top-level folders for a single specific account
    
    Set accountFolder = Session.Folders(1)  'or Session.Folders("Account Name")
    
    'Create list of top-level folders in this account
    
    allTopFolders = ""
    For Each topFolder In accountFolder.Folders
        allTopFolders = allTopFolders & "'" & topFolder.Name & "',"
    Next
    strScope = Left(allTopFolders, Len(allTopFolders) - 1)
    
    Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")
    
    'Save the search results in a folder inside Search Folders in the Outlook UI
    
    objSearch.Save strFilter
    
    Set objSearch = Nothing

    Exit Sub
     
Err_SearchFolderForSender:
    MsgBox "Error # " & Err & " : " & Error(Err)
 
End Sub
 
Last edited:
Upvote 0
Yes, there multiple accounts.

I was away for a month when came back they created a share account called ap that's why also my rules not working either.

I'm using Outlook 2016 is office 365 plus package.

Thank you for all your help, much appreciated.
 
Upvote 0
Hi,

I know this question is stupid, how do i know what's the account name or index number in outlook? for example Inbox is that the account name, and the share folder is called NCL AP is tat the other account name?

sorry I am not that familiar with account name or index in outlook.

thank you,
 
Upvote 0
The account name is the 'folder' you see above the Inbox and contains all the top-level folders, including the Inbox for that account.

Just try different index numbers starting at 1 and add this MsgBox line to display the name of that account and run the macro again until it shows the correct account:

Code:
Set accountFolder = Session.Folders(1)   'Try 1, 2 
MsgBox "Account Name = " & accountFolder.Name
Stop
"NCL AP" might be the account name - I'm not sure how accounts work with shared folders. You could try:
Code:
Set accountFolder = Session.Folders("NCL AP")
 
Last edited:
Upvote 0
thank you very much for your help.

with your tips i was able to found out the second account name which is index 1

but run code gave me run time error 2147024809 (80070057) and highlight this line of the code:

Code:
Set objSearch = Application.AdvancedSearch(Scope:=strScope, Filter:=strDASLFilter, SearchSubFolders:=True, Tag:="SearchFolder")

thanks again
 
Upvote 0

Forum statistics

Threads
1,223,677
Messages
6,173,796
Members
452,534
Latest member
autodiscreet

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top