Ich organisiere meine E-Mails in Outlook in verschiedenen Ordnern. Dabei landen diese in den Unterordnern wenn ich die Mails gelesen habe. Die Anzahl der Unterordner in Outlook wird mit der Zeit recht groß. Jedoch gibt es eine “Top Ten” der Ordner in denen die E-Mails landen.
Um die E-Mails schneller dahin zu verschieben, habe ich im Outlook die Ribbon Bar angepasst und verschiedene Makros abgelegt. Mit Hilfe der Makros werden die markierten Mails dann in entsprechende Ordner verschoben und als gelesen markiert.
VBA – Makros zum verschieben von E-Mails
Mit dem folgenden VBA Makros werden meine Mails verschoben.
Teil 1 – VerschiebeInGelesen()
Die Funktion VerschiebeInGelesen() gibt es pro Zielordner . Hier wird die Hauptfunktion aufgerufen und der Pfad zum Ordner übergeben.
Teil 2 – VerschiebeEMail(ZielOrdner As String)
Hier wird in der Funktion VerschiebeEMail(ZielOrdner As String) in einer FOR Schleife jede markierte E-Mail als gelesen markiert und in den Unterordner verschoben.
Zuvor wird der Zielordner Pfad in ein Array umgewandelt und anschließend als MAPIFolder Objekt zurück gegeben.
''' Je Ordner ein Sub Aufruf ''' Teil 1 Sub VerschiebeInGelesen() VerschiebeEMail ("\\<Postfachname>\Posteingang\<Zielordner>") End Sub ''' Verschiebt E-Mails in einen Zielordner ''' Die Pfadangabe aus Outlook kopieren ''' Teil 2 Sub VerschiebeEMail(ZielOrdner As String) Dim strOutlookFolderPath As String Dim oulAusgewaehlte As Outlook.Selection Dim intZähler As Integer Dim strOutlookMAPIFolders() As String Dim mapFld As MAPIFolder Set oulAnwendung = CreateObject("Outlook.Application") Set oulAusgewaehlte = oulAnwendung.ActiveExplorer.Selection strOutlookFolderPath = ZielOrdner strOutlookMAPIFolders = GetOutlookMapiFolder(strOutlookFolderPath) Set mapFld = GetOutlookMapiObject(strOutlookMAPIFolders) For intZähler = 1 To oulAusgewaehlte.Count oulAusgewaehlte.Item(intZähler).UnRead = False oulAusgewaehlte.Item(intZähler).Move mapFld Next intZähler End Sub
Teil 3 – GetOutlookMapiObject(OutlookMAPIFolders() As String) As MAPIFolder
Erstellt aus dem Array OutlookMAPIFolders() ein MAPIFolder Objekt. Dieses enthält den Pfad zum Ziel Ordner in Outlook
Teil 4 – GetOutlookMapiFolder(OutlookPath As String) As Variant
Wandelt den String Pfad zum Zielordner in ein Array um
''' Erstellt aus einem Outlook Ordner Array eine MAPIFolder Objekt ''' Teil 3 Private Function GetOutlookMapiObject(OutlookMAPIFolders() As String) As MAPIFolder Dim zaehler As Integer Dim retVal As MAPIFolder Dim mapFld As MAPIFolder zaehler = 0 ''Set retVal = Application.Session.Folders() For Each strFolder In OutlookMAPIFolders If zaehler = 0 Then Set retVal = Application.Session.Folders(strFolder) zaehler = zaehler + 1 Else Set retVal = retVal.Folders(strFolder) End If Next Set GetOutlookMapiObject = retVal End Function ''' String mit Pfad zum Outlook Ordner in Array speichern ''' Teil 4 Private Function GetOutlookMapiFolder(OutlookPath As String) As Variant Dim retVal() As String If InStr(1, OutlookPath, "\\") Then strTemp = Mid(OutlookPath, 3) retVal = Split(strTemp, "\") End If GetOutlookMapiFolder = retVal End Function
Das damit angelegte Makro kann nun in Outlook eingebunden werden.
Ich habe dazu im Ribbon eine neue Registerkarte angelegt.
Neue Registerkarte im Outlook Ribbon / Menüband anlegen
In Outlook Datei und dann Optionen öffnen. In den Outlook-Optionen auf Menüband anpassen klicken.
Neue Registerkarte anklicken. Dort Neue Gruppe öffnen.
Nun kann über Befehle auswählen – Makros ein Makros in die neue Registerkarte hinzugefügt werden.