List folders in a combo box + select folder + move emails from inbox to that folder + reply to that email

[reubendayal]

Hi All,

I work with several cases that are subfolders under 2 different shared mailboxes. When replying to an email on a specific case, I need to move it to the case folder, and then reply to it (so the reply gets saved in the same folder). So I am trying to find a faster way of doing this.

The problem is the step with putting together a macro that can list all the sub folders from the two shared mailboxes. What I need help with is (to describe in a chronological manner):

1. once I have selected an email/s in the inbox, i call the macro by a keyboard shortcut,
2. the macro then displays a list of folders from the two shared mailboxes, and i just need to type the case folder name's first or second characters for the combobox to select it, and then hit okay,
3. the macro then selects the path of the case folder, and moves the email/s I had selected to the subfolder's path
4. it then selects the sub folder as the active folder and ReplyAll to the email that was just moved (else replyall to the latest of the emails that were moved)

My below macro is only able to move a selection of the emails to a folder, but uses the pickfolder method that is super slow. And eventually when the email/s are moved, and I select the subfolder as the active folder, outlook simply selects the latest message or the last selected message in that folder - which means I lose track of the email that was moved. So doesnt achieve what I am trying to do.

Sub InitiationMoveEmail_GotoFolder()

    Dim objNS As Outlook.NameSpace
    Dim objDestFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
        
    Set objNS = Application.GetNamespace("MAPI")
    
' Pick the destination folders
   Set objDestFolder = objNS.PickFolder

  If Not (objDestFolder Is Nothing) Then
    Set objItem = Application.ActiveExplorer.Selection.Item(1)
        For Each objItem In ActiveExplorer.Selection
            objItem.Move objDestFolder
        Next
    Set Application.ActiveExplorer.CurrentFolder = objDestFolder
    
    Else
        MsgBox "Outlook Folder is not created!", vbOKOnly + vbCritical, "Exiting Automation"
    Exit Sub
        
  End If
 
  Set objDestFolder = Nothing
  Set objNS = Nothing


End Sub

 

[reubendayal]

Hi All,

Anyone that can help with the above issue?

Additionally, I have tried tweaking Diane's helpful code on printing the outlook folder list. But the macro does take quite a while (approx. 10-15 seconds) to retrieve the folder list and then it only displays the list in an email, and I am unsure on how to make it display the same in a combobox macro instead.

Public Sub GetFolderNames()
    Dim olApp As Outlook.Application
    Dim olSession As Outlook.NameSpace
    Dim olStartFolder As Outlook.MAPIFolder
    Dim MyFolder As Folder

    Set olApp = New Outlook.Application
    Set olSession = olApp.GetNamespace("MAPI")
      
     ' Allow the user to pick the folder in which to start the search.
    
    Set MyFolder = Session.Folders("DK Mailbox").Folders("Inbox").Parent.Folders("Assignees 2020")
    
    Set olStartFolder = MyFolder 'olSession.PickFolder
      
     ' Check to make sure user didn't cancel PickFolder dialog.
'    If Not (olStartFolder Is Nothing) Then
         ' Start the search process.
        ProcessFolder olStartFolder
'    End If
    
'*** Create a new mail message with the folder list inserted
Set ListFolders = Application.CreateItem(olMailItem)
  ListFolders.Body = strFolders
  ListFolders.Display
      
'MsgBox strFolders
      
' clear the string so you can run it on another folder
  strFolders = ""
End Sub
 
Sub ProcessFolder(CurrentFolder As Outlook.MAPIFolder)
        
    Dim i As Long
    Dim olNewFolder As Outlook.MAPIFolder
    Dim olTempFolder As Outlook.MAPIFolder
    Dim olTempFolderPath As String
     ' Loop through the items in the current folder.
    For i = CurrentFolder.Folders.Count To 1 Step -1
          
        Set olTempFolder = CurrentFolder.Folders(i)
          
        olTempFolderPath = olTempFolder.FolderPath

'     ' Get the count of items in the folder
'         olCount = olTempFolder.Items.Count
'
'     'prints the folder path and name in the VB Editor's Immediate window
         'Debug.Print olTempFolderPath '& " " & olCount
          
        ' prints the folder name only
          'Debug.Print olTempFolder
          
         ' create a string with the folder names.
         ' use olTempFolder if you want foldernames only
         strFolders = strFolders & vbCrLf & olTempFolder ' & " " & olCount
        
        'lCountOfFound = lCountOfFound + 1
          
    Next
     ' Loop through and search each subfolder of the current folder.
    For Each olNewFolder In CurrentFolder.Folders
          
         'Don't need to process the Deleted Items folder
        If olNewFolder.Name <> "Deleted Items" Then
            ProcessFolder olNewFolder
        End If
          
    Next
    
End Sub