Zeitsparende Lösungen für Outlook: Automatisiertes Kopieren von Ordnerhierarchien

Outlook VBA

Sicherlich haben Sie in Ihrem Arbeitsalltag schon einmal die Notwendigkeit verspürt, in Microsoft Outlook eine bestehende Ordnerstruktur zu kopieren, ohne die darin enthaltenen E-Mails oder anderen Inhalte mitzukopieren. Dies kann besonders hilfreich sein, wenn Sie für verschiedene Projekte oder regelmäßige Aufgaben eine spezifische Ordnerhierarchie benötigen. Standardmäßig bietet Outlook keine direkte Funktion, um nur die Ordnerstruktur zu replizieren. Hier kommt die Verwendung eines VBA-Makros ins Spiel.

Durch das Schreiben eines einfachen Makros können Sie die gewünschte Funktionalität erreichen: die Möglichkeit, nur die Ordnerstruktur eines Postfachs zu kopieren, ohne die Inhalte der Ordner zu berücksichtigen. Dies spart nicht nur Zeit, sondern auch die manuelle Mühe, die sonst mit dem Neuerstellen komplexer Ordnerstrukturen verbunden wäre. Im Folgenden finden Sie eine Anleitung, wie Sie ein solches Makro erstellen und verwenden können.

  • Öffnen Sie den Visual Basic Editor in Outlook: Drücken Sie Alt + F11 in Outlook.
  • Fügen Sie ein neues Modul hinzu: Gehen Sie im Projekt-Explorer zu Ihrem Outlook-Projekt, klicken Sie mit der rechten Maustaste darauf und wählen Sie Einfügen > Modul.
  • Kopieren Sie das folgende Makro in das neue Modul:

Sub CopyFolders()
Dim SourceFolder As Outlook.Folder
Dim TargetFolder As Outlook.Folder
Dim Folder As Outlook.Folder

Set SourceFolder = GetFolder("Wählen Sie den Quellordner aus")
If SourceFolder Is Nothing Then Exit Sub

Set TargetFolder = GetFolder("Wählen Sie den Zielordner aus")
If TargetFolder Is Nothing Then Exit Sub

CopySubFolders SourceFolder, TargetFolder
MsgBox "Ordnerkopie abgeschlossen!", vbInformation
End Sub

Sub CopySubFolders(SourceFolder As Outlook.Folder, TargetFolder As Outlook.Folder)
Dim SubFolder As Outlook.Folder
Dim NewFolder As Outlook.Folder

For Each SubFolder In SourceFolder.Folders
Set NewFolder = TargetFolder.Folders.Add(SubFolder.Name)
CopySubFolders SubFolder, NewFolder
Next SubFolder
End Sub

Function GetFolder(Title As String) As Outlook.Folder
Dim objNS As Outlook.NameSpace
Set objNS = Application.GetNamespace("MAPI")

Set GetFolder = objNS.PickFolder
If Not GetFolder Is Nothing Then
MsgBox "Ausgewählter Ordner: " & GetFolder.FolderPath, vbInformation, Title
End If

Set objNS = Nothing
End Function

  • Führen Sie das Makro aus: Drücken Sie Alt + F8, wählen Sie CopyFolders aus der Liste und klicken Sie auf Ausführen.

Bitte beachten Sie, dass das Ausführen von Makros Sicherheitsrisiken birgt. Stellen Sie sicher, dass Sie den Code verstehen, bevor Sie ihn ausführen, und dass Ihr Outlook so konfiguriert ist, dass die Ausführung von Makros erlaubt ist. Auch sollten Sie bedenken, dass VBA-Makros nicht auf allen Plattformen (wie Outlook für das Web oder mobile Apps) funktionieren.

 

Ähnliche Beiträge:

  1. Lösungen für hohe Speicher- und CPU-Auslastung bei Microsoft Outlook
  2. Wer hat die E-Mail gelesen? Lösungen für gemeinsame Postfächer in Outlook
  3. Von „ANHÄNGE“ zu „GESENDET“: Ein Outlook Makro für strukturierten E-Mail-Versand

-

Vorheriger Artikel Nächster Artikel

Hat Ihnen der Beitrag gefallen?

1 Stern2 Sterne3 Sterne4 Sterne5 Sterne (Keine Bewertung vorhanden)
Loading...

2 Kommentare zu “Zeitsparende Lösungen für Outlook: Automatisiertes Kopieren von Ordnerhierarchien”

  1. Nahuel

    Ich verwende das Makro in Outlook 365. Leider muss ich die Ordner immer noch etwas manuell verschieben. Denn: Ich wähle eine PST Datei, muss aber beim Zielordner eine Ebene unterhalb wählen, sonst kommt ein Laufzeitfehler. Mache ich etwas falsch? Also ich habe eine PST Datei die heisst 2025 – also alle meine Mails von 2025 werden dorthin verschoben. Ich erstelle eine PST Datei 2026 und will die Struktur 2025 kopieren ich muss jedoch bei 2026 eine Ebene unterhalb wählen mit diesem Makro… Chat GPT konnte mir leider auch nicht weiterhelfen und ich habe 0 Ahnung von Makros, ausser kopieren und ausführen 😉

    Antwort ↓
    1. Mailhilfe Artikelautor

      Danke für die ausführliche Beschreibung!
      Du machst nichts falsch, aber das Verhalten, das du beschreibst, liegt an einer kleinen technischen Eigenheit in Outlooks Objektmodell.

      Was passiert da genau?
      Wenn du eine neue PST-Datei wie „2026“ erstellst, erscheint sie in Outlook als ein Root-Ordner (also ganz oben in der Struktur). Dieser Root-Ordner ist kein richtiger Container für Unterordner, wie es z. B. „Posteingang“ oder „Gesendete Elemente“ sind. Deshalb kann Outlook beim Versuch, dort direkt Unterordner zu erstellen, einen Laufzeitfehler auslösen.

      Lösung: Automatisch einen Ziel-Unterordner anlegen
      Wir können das Makro so anpassen, dass es erkennt, wenn du einen Root-Ordner wie „2026“ auswählst, und dann automatisch einen Unterordner darin erstellt (z. B. „Strukturkopie“), in den die Ordnerstruktur kopiert wird.

      Hier ist die überarbeitete Version des Makros:

      Sub CopyFolders()
      Dim SourceFolder As Outlook.Folder
      Dim TargetFolder As Outlook.Folder
      Dim RealTargetFolder As Outlook.Folder

      Set SourceFolder = GetFolder(„Wählen Sie den Quellordner aus“)
      If SourceFolder Is Nothing Then Exit Sub

      Set TargetFolder = GetFolder(„Wählen Sie den Zielordner aus“)
      If TargetFolder Is Nothing Then Exit Sub

      ‚ Wenn der Zielordner keine Unterordner enthalten darf, erstelle einen neuen Unterordner
      On Error Resume Next
      Dim Test As Object
      Set Test = TargetFolder.Folders
      If Err.Number <> 0 Then
      Err.Clear
      Set RealTargetFolder = TargetFolder.Parent.Folders.Add(„Strukturkopie“)
      Else
      Set RealTargetFolder = TargetFolder
      End If
      On Error GoTo 0

      CopySubFolders SourceFolder, RealTargetFolder
      MsgBox „Ordnerkopie abgeschlossen!“, vbInformation
      End Sub

      Sub CopySubFolders(SourceFolder As Outlook.Folder, TargetFolder As Outlook.Folder)
      Dim SubFolder As Outlook.Folder
      Dim NewFolder As Outlook.Folder
      Dim ExistingFolder As Outlook.Folder

      For Each SubFolder In SourceFolder.Folders
      On Error Resume Next
      Set ExistingFolder = TargetFolder.Folders(SubFolder.Name)
      On Error GoTo 0

      If ExistingFolder Is Nothing Then
      Set NewFolder = TargetFolder.Folders.Add(SubFolder.Name)
      Else
      Set NewFolder = ExistingFolder
      End If

      CopySubFolders SubFolder, NewFolder
      Next SubFolder
      End Sub

      Function GetFolder(Title As String) As Outlook.Folder
      Dim objNS As Outlook.NameSpace
      Set objNS = Application.GetNamespace(„MAPI“)

      Set GetFolder = objNS.PickFolder
      If Not GetFolder Is Nothing Then
      MsgBox „Ausgewählter Ordner: “ & GetFolder.FolderPath, vbInformation, Title
      End If

      Set objNS = Nothing
      End Function

      Antwort ↓

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert