Find Folder Misplaced in Outlook

[nandeotifur]

I am currently trying to modify some code to be able to find a folder that may have been moved in error within Outlook 2013. I am a beginner at VBA coding(Outlook Macros), and want to see if this may be possible.

Premise:

User has multiple mailboxes, pst files and public/shared mailboxes.
User has multiple Folders named the same (eg "\\emailaddress\Inbox\Monthly Review" and "\\2014\Monthly Review")
User trying to locate moved folder to put back to original location

Issues:

Current code accepts Boolean search but stops at first instance of folder ("\\emailaddress\Inbox\Monthly Review")
Also, script seems to only be able to run effectively while Outlook is in work offline mode. When Outlook is online, it freezes the Outlook session until you cancel server requests.

Anyone have an idea as to how to fix these two issues? Trying to get this when you hit no as to the folder location prompt it goes to the next folder matching the context until search is exhausted or you select yes for the proper folder. Work offline issue is not to important, more of a feature creep I guess.

Sub FindFolderByName()
    Dim Name As String
    Dim FoundFolder As Folder
     
    Name = InputBox("Find Name:", "Search Folder")
    If Len(Trim$(Name)) = 0 Then Exit Sub
     
    Set FoundFouder = FindInFolders(Application.Session.Folders, Name)
     
  If Not FoundFouder Is Nothing Then
    If MsgBox("Activate Folder: " & vbCrLf & FoundFouder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
      Set Application.ActiveExplorer.CurrentFolder = FoundFouder
    End If
  Else
    MsgBox "Not Found", vbInformation
  End If
End Sub
Function FindInFolders(TheFolders As Outlook.Folders, Name As String)
  Dim SubFolder As Outlook.MAPIFolder
   
  On Error Resume Next
   
  Set FindInFolders = Nothing
   
  For Each SubFolder In TheFolders
    If LCase(SubFolder.Name) Like LCase(Name) Then
      Set FindInFolders = SubFolder
      Exit For
    Else
      Set FindInFolders = FindInFolders(SubFolder.Folders, Name)
      If Not FindInFolders Is Nothing Then Exit For
    End If
  Next
End Function

Thanks in advance to all who wish to contribute their advice.

[nandeotifur]

Adding this code as a separate process helps

Sub ToggleWorkOfflineMode()    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")
    If Not OutApp.Session.Offline = True Then
        If MsgBox("Do you want to enable Work Offline Status?", vbQuestion Or vbYesNo) = vbYes Then
            OutApp.GetNamespace("MAPI").Folders.GetFirst.GetExplorer.CommandBars.FindControl(, 5613).Execute
        Else
            MsgBox "Status Not Changed.", vbInformation
        End If
    Else
        If MsgBox("Do you Want to disable Work Offline Status?", vbQuestion Or vbYesNo) = vbNo Then
            MsgBox "Working offline", vbInformation
        Else
            OutApp.GetNamespace("MAPI").Folders.GetFirst.GetExplorer.CommandBars.FindControl(, 5613).Execute
        End If
    End If
End Sub

Trying to see though how to integrate into initial code as it breaks focus of activating folder if I call as a function. I am still looking to see how to enumerate instances of items found in case user has multiple similar folder names.

I am currently trying to modify some code to be able to find a folder that may have been moved in error within Outlook 2013. I am a beginner at VBA coding(Outlook Macros), and want to see if this may be possible.

Premise:

User has multiple mailboxes, pst files and public/shared mailboxes.
User has multiple Folders named the same (eg "\\emailaddress\Inbox\Monthly Review" and "\\2014\Monthly Review")
User trying to locate moved folder to put back to original location

Issues:

Current code accepts Boolean search but stops at first instance of folder ("\\emailaddress\Inbox\Monthly Review")
Also, script seems to only be able to run effectively while Outlook is in work offline mode. When Outlook is online, it freezes the Outlook session until you cancel server requests.

Anyone have an idea as to how to fix these two issues? Trying to get this when you hit no as to the folder location prompt it goes to the next folder matching the context until search is exhausted or you select yes for the proper folder. Work offline issue is not to important, more of a feature creep I guess.

Sub FindFolderByName()
    Dim Name As String
    Dim FoundFolder As Folder
     
    Name = InputBox("Find Name:", "Search Folder")
    If Len(Trim$(Name)) = 0 Then Exit Sub
     
    Set FoundFouder = FindInFolders(Application.Session.Folders, Name)
     
  If Not FoundFouder Is Nothing Then
    If MsgBox("Activate Folder: " & vbCrLf & FoundFouder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
      Set Application.ActiveExplorer.CurrentFolder = FoundFouder
    End If
  Else
    MsgBox "Not Found", vbInformation
  End If
End Sub
Function FindInFolders(TheFolders As Outlook.Folders, Name As String)
  Dim SubFolder As Outlook.MAPIFolder
   
  On Error Resume Next
   
  Set FindInFolders = Nothing
   
  For Each SubFolder In TheFolders
    If LCase(SubFolder.Name) Like LCase(Name) Then
      Set FindInFolders = SubFolder
      Exit For
    Else
      Set FindInFolders = FindInFolders(SubFolder.Folders, Name)
      If Not FindInFolders Is Nothing Then Exit For
    End If
  Next
End Function

Thanks in advance to all who wish to contribute their advice.