Outlook 2013 - Markierte E-Mail in einen fest definierten Ordner verschieben - One-Click-Lösung

Hallo,

ich bin's nochmal mit meiner nächsten Outlook Frage.

Mein Wunsch ist es, einen Button zu basteln, der die zur Zeit ausgewählte/ausgewählten E-Mails in einen vordefinierten Ordner verschiebt. Wie der Titel schon sagt, mit nur einem Click ohne noch eine Auswahl des Ordners treffen zu müssen. Aus Erfahrung weis ich, dass wenn ich unseren Leuten die Auswahl gebe, Sie die falschen Ordner auswählen. Auch Drag & Drop ist keine gute Alternative

Beispiel: Wir bekommen unsere Faxe als E-Mail in einem Öffentlichen Ordner "Fax-Eingang" ... nachdem sich jemand diesem Fax angenommen hat soll er diese Fax-E-Mail in einen Unterordner von "Fax-Eingang" verschieben ... nämlich "erledigte Faxe".

Im Grunde genau die Funktionalität die ich unter QuickSteps unter "Verschieben..." einstellen kann. Nur hat die QuickSteps-Funktion zwei Punkte warum ich sie nicht benutzen kann.

1. diese kleine Ansicht ist unschön, ich würde unseren Leuten lieber schöne große Buttons mit den wichtigsten Funktionen zur Verfügung stellen. (per Menüband anpassen)
2. bietet QuickSteps unter Verschieben nicht die Möglichkeit Öffentliche Ordner auszuwählen. Und unsere gewünschte Ordnerstruktur sieht es nun mal vor das die von mir gewünschten Ordner als Öffentliche Ordner vorliegen.

Nach einigem Suchen habe ich nur Lösungen gefunden die nicht genau dem entsprochen haben was ich benötige und aus den Lösungen das raus zu fischen was ich brauche ist mir leider nicht gelungen.

Ich hoffe hier kann mir jemand weiterhelfen. Entweder mit einem Makro oder einem anderen Lösungsweg.

Mfg Balgor

Sub MoveMailTo()
Dim objFolder As Object
Dim objItem As Object
On Error Resume Next
Set objFolder = Outlook.Session.Folders("Öffentliche Ordner").Folders("Alle Öffentlichen Ordner").Folders("erledigte Faxe")  
For Each objItem In Outlook.ActiveExplorer.Selection
Call objItem.Move(objFolder)
Next
Set objItem = Nothing
Set objFolder = Nothing
End Sub

Sub MoveSelection()
    dim fldrTarget as Folder, itm as Object
    Set fldrTarget = Application.GetNamespace("MAPI").GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Fax-Eingang").Folders("erledigte Faxe")  
   if ActiveExplorer.Selection.Count > 0 then
      For Each itm In ActiveExplorer.Selection
          itm.Move fldrTarget
      Next
   else
       Msgbox "Bitte markieren sie mindestens eine Mail die verschoben werden soll.",vbExclamation  
   End if
End Sub