CODEWITHSUNDEEP
vbaoutlookadvanced-search
Free Url
Free Url

Reputation: 1966

Scope using AdvancedSearch method for entire mailbox

I am trying to look through all Outlook folders for mail items matching certain parameters to save the attachment, from Excel.

I don't know how to reference scope to go through all folders, even custom folders.

I can't find the resources that answer my question.

Sub testing()

Dim myOlApp As New Outlook.Application
Dim scope As String
Dim filter As String
Dim rsts As Results
Dim AdvancedSearch As Outlook.Search

blnSearchComp = False

'I want it to search the entire mail account including normal folders like inbox and sent as well as custom folders.
'but this doesn't work. Any ideas?
scope = "'[email protected]'"
'filter assignment statement has been excluded

Set AdvancedSearch = myOlApp.AdvancedSearch(scope, filter, True, "test")  

While blnSearchComp <> True
    If AdvancedSearch.Results.Count > 0 Then
        blnSearchComp = True
    End If
Wend

Set rsts = AdvancedSearch.Results

For x = rsts.Count To 1 Step -1
    rsts.Attachment.Item(x).SaveAsFile Project
Next

End Sub

Upvotes: 1

Views: 1706

Answers (2)

niton
niton

Reputation: 9179

Scope should be

'\\[email protected]'

Sub Demo_scopeformat()

Dim myOlApp As New outlook.Application
Dim scope As String

' Mailbox
scope = "'" & myOlApp.Session.GetDefaultFolder(olFolderInbox).Parent.folderPath & "'"

' Expected format
Debug.Print scope

End Sub

Upvotes: 2

Free Url
Free Url

Reputation: 1966

Well, I know it isn't the best solution, but I have come up with the following code to make a list of all of the parent folders, so that a for loop can be used with advanced search method to iterate the list. This will not be the fastest possible code, but should not be too slow.

Sub main()
'establishes connections
Dim myOlApp As New Outlook.Application
Dim objNS As Outlook.Namespace
Dim myFolder As Outlook.MAPIFolder
Set objNS = myOlApp.GetNamespace("MAPI")
'pick highest folder level as original my folder
Set myFolder = objNS.Folders("[email protected]")

Call ProcessFolders(myFolder)

End Sub

Sub ProcessFolders(myFolder)

're establish connections
Dim myOlApp As New Outlook.Application
Dim objNS As Outlook.Namespace
Dim objFolder As Outlook.MAPIFolder
Set objNS = myOlApp.GetNamespace("MAPI")
'set up collection
Set x = New Collection

For Each objFolder In myFolder.Folders
'add all parent folder names to collection
'advanced search method will handle subfolders
'can use a recursive call here also to get subfolders though
    x.Add objFolder.Name
Next


Set objNS = Nothing
Set myFolder = Nothing
Set myOlApp = Nothing

End Sub

Upvotes: 0

Related Questions