MoveSubFolder

Besonders die VBScript Variante zeigt gut, wie man mit einem Skript und dem Taskplaner bestimmte Funktionen auch als geplante Tätigkeit asynchron durchführen kann.

VBScript funktioniert nicht mit Outlook 2007 MAPI. Bitte auf Exchange 2003 Server ausführen
VBA Skript Funktioniert aber auch in Outlook 2007
Details: http://blogs.msdn.com/stephen_griffin/archive/2007/05/30/outlook-2007-public-folders-mapi-and-you.aspx

Der Ursprung dieses kleinen VBA-Makros ist die Aufgabenstellung, sehr viele Nachrichten in einem Ordner in verschiedene Unterordner zu verlagern. Exchange und Outlook haben Probleme, wenn in einem Ordner sehr viele Elemente liegen. In der Regel wird die Antwortzeit von Outlook immer länger, wen in einem Ordner 5000 oder mehr Element liegen. Die Anzahl der Elemente ist das Problem, weniger die Größe in Megabyte. Das geht soweit, dass Sie einen Ordner mit Outlook gar nicht mehr anzeigen können, da Outlook quasi "ewig" drauf wartet, bis Exchange die Elemente in der gewünschten Ansicht sortiert hat.

Hier hilft dieses VBA-Makro, welches alle Elemente in einem gegebenen Ordner in dynamisch angelegte Ordner nach der Jahreszahl anlegt. Damit wird die Anzahl der Elemente auf verschiedene Ordner verteilt. Da jedoch auch Anfragen zu einer "automatischen Lösung" gestellt wurden, gibt es auch eine VBScript-Version, welche CDO nutzt. Diese ist natürlich etwas länger, da das Programm sich selbst um MAPI kümmern muss.

die ursprünglich geplante Powershell-Version musste ich leider einstellen, da unter Powershell und .NET die Nutzung der CDO-Schnittstelle trotz "COM-Interop" anscheinend nicht wirklich funktioniert.

VBA-Version

Der in VBA entwickelte Code ist so einfach, dass ich ihn hier schon direkt zum Lesen bereit stelle. Sie können Ihn natürlich auch als BAS-Datei herunterladen und in Outlook einbinden:

Option Explicit

Sub MoveSubfolder()
    ' Pick a folder and moves Items in Subfolders by year

    Dim objFolder As MAPIFolder
    Set objFolder = Outlook.GetNamespace("MAPI").PickFolder

    Dim oMsgColl As Items
    Dim objItem As Object  ' normally Mailitem, but not always
    Set oMsgColl = objFolder.Items
    Set objItem = oMsgColl.GetFirst
    Do While (Not objItem Is Nothing)
        Debug.Print "Found:" & objItem.ReceivedTime & " - " & objItem.subject
        On Error Resume Next
        If objFolder.Folders(objFolder.Name & "-" & CStr(Year(objItem.ReceivedTime))) Is Nothing Then
            Debug.Print "Neuer Ordner angelegt: " & objFolder.Name & "-" & CStr(Year(objItem.ReceivedTime))
            objFolder.Folders.Add (objFolder.Name & "-" & CStr(Year(objItem.ReceivedTime)))
        End If
        Err.Clear: On Error GoTo 0
        objItem.Move (objFolder.Folders(objFolder.Name & "-" & CStr(Year(objItem.ReceivedTime))))
        Set objItem = oMsgColl.GetNext
    Loop
End Sub

Sie können den Code einfach über die Zwischenablage in den VBA Editor in Outlook übernehmen.

Download
movesubfolder.bas
Bitte als *.BAS-Datei abspeichern und in Outlook einbinden.
Siehe auch Outlook VBA

Durch den Verzicht auf die "Folder.Items" bzw. Folder.Messages-Aufzählung und den Einsatz von Get-First/Get-Next funktioniert das Skript auch mit sehr großen Objekten in einem Ordner. Allerdings kann auch das Aufspiltten von 100.000 Elementen in Unterordner durchaus einige Zeit dauern. Wer mag, kann das Skript um einen "Counter" erweitern und diesen z.B. in einem Fenster oder im Debug-Fenster anzeigen lassen.

VBScript-Version

Wenn Sie die interaktive VBA-Version auch automatisch ausführen lassen wollen, dann ist der Taskplaner natürlich eine Möglichkeit, das folgende VBScript zu starten. Im Gegensatz zum klassischen VBA-Makro muss man hier natürlich wieder Servername, Postfachname und Ordnerpfad entsprechend hinterlegen, das die "Outlook Umgebung" genauso fehlt wie die Interaktion der Auswahl mit der "PickFolder"-Methode. Zudem habe ich mit der VBScript-Version gleich ein paar weitere Punkte meiner "Wunschliste" eingebaut:

 

Das Skript tut sich noch etwas schwer mit Windows 2008 und Exchange 2007, da hier die CDO per Default keine öffentlichen Ordner mehr in Infostore bereitstellt, sondern dies erst nach deinem Zugriff auf die Mailbox tut (siehe auch MAPI/CDO)
Etwas Geduld daher noch

Für die Unterstützung einer Notes Migration gibt es dieses Skript schon für die Verlagerung von Ordnern in einem Postfach per CDO. Die Transporter Suite hat leider die Angewohnheit, die migrierten Ordner direkt auf der Ebene des Postfachs, d.h. parallel zu Posteingang etc.) abzulegen. Das VBScript kann genutzt werden, um durch alle Postfächer zu flitzen und die "nicht Systemordner" in einen vorgegebenen Unterordner (z.B. Ablage oder Archiv) zu verschieben.

Einschränkungen

Wer schon so viele Elemente in einem Ordner im Postfach hat, der freut sich vielleicht über dieses Skript, aber kann im gleichen Zuge auch in die nächste Falle tappen. Auch die Anzahl der Unterordner in einem Ordner ist nicht endlos steigerbar. So legt Exchange 2003 SP2 ein Standardlimit von 500 Ordnern (objectfolder) fest.

Dann wird es um so wichtiger, z.B.: unter dem Jahresordner noch Monate zu unterteilen, statt einen Ordner mit "Ordnername-Monat-Jahr" anzulegen. Auch das Verteilen nach der Absenderdomain (z.B.: nach Kunden) kann aufgrund der Default Grenzwerte sehr schnell zu Verdruss führen. Sicher können Sie die Grenzwerte abändern. Zukunftssicherer ist jedoch die Überlegung, ob Sie Outlook und Exchange hier nicht als CRM-System missbrauchen, was es definitiv nicht ist.

Weiterentwicklung

Das Skript ist nur ein Muster, wie schnell und einfach per VBA ein ansonsten nicht mehr nutzbarer Ordner reanimiert werden kann. Es ist aber nur ein Muster und vielleicht wünschen Sie sich Anpassungen. denkbar wäre z.B.

Sie sehen also, dass das Grundgerüst beinahe beliebig erweitert werden kann.

Weitere Links

Keywords: VBA 5000 SubFolder Move Verschieben