excelvbaoutlookoutlook-2010

Add Outlook Search Folder on shared folder


I'm trying to create a new "Search Folder" in an Outlook shared folder using VBA in Excel.
It is failing on the last line, which is the save function.

"Object could not be found".

Sub createfolder()

    Dim oApp As Outlook.Application
    Dim oSearch As Outlook.Search
    Dim oInbox  As Outlook.mapifolder
    Dim sFolderPath As String
    Dim oScope As String
    Dim sFilter As String

    Set oApp = New Outlook.Application
    Set oInbox = oApp.GetNamespace("MAPI").Folders("Fin Reporting").Folders("July")

    sFolderPath = oInbox.FolderPath
    sScope = "'" & oInbox.FolderPath & "'"
    Set oSearch = oApp.AdvancedSearch(sScope)
    
    oSearch.Save ("TestSearch")

End Sub

Solution

  • you did not say where your "fin reporting" folder is located

    for this example code, i put it in the top folder, so it is on same level as "inbox"

    top ---
           |
           fin reporting
           |   |
           |   july
           |
           inbox
           |
           sent items
           |
           etc. 
    

    try these two. see which one works, or does not work.

    single-step through the code by pressing F8 key repeatedly

    try this one in outlook

    Sub createfolder_outlook()
    
        Dim oInbox  As MAPIFolder
        Dim oSearch As Search
    
        Set oInbox = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Fin Reporting").Folders("July")
        Set oSearch = Application.AdvancedSearch("'" & oInbox.FolderPath & "'")
    
        oSearch.Save ("TestSearch")
    
    End Sub
    

    then do same in excel

    Sub createfolder_excel()
    
        Dim oInbox  As Outlook.MAPIFolder
        Dim oSearch As Outlook.Search
    
        Set oInbox = Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(Outlook.olFolderInbox).Parent.Folders("Fin Reporting").Folders("July")
        Set oSearch = Outlook.Application.AdvancedSearch("'" & oInbox.FolderPath & "'")
    
        oSearch.Save ("TestSearch")
    
    End Sub