Ordnerstruktur kopieren

In Outlook gibt es keine Funktion, um nur die Ordnerstruktur ohne Inhalte zu kopieren. Dieses Makro kopiert nur die Ordner und nicht die Inhalte. Das spart eine Menge Klicks, wenn Sie z.B. für Projekte immer wieder die gleiche Ordnerhierarchie verwenden.

Starten Sie das Makro 'CopyFolders' z.B. über alt+f8. Zuerst wählen Sie den Quellordner, also den, dessen Unterordner alle kopiert werden sollen, dann den Zielordner. Das war´s, den Rest erledigt das Makro für Sie.

  So fügen Sie Makros in Outlook ein

Public Sub CopyFolders()
  Dim Source As Outlook.Folder
  Dim Target As Outlook.Folder
  
  'Quellordner wählen
  Set Source = Application.Session.PickFolder
  If Source Is Nothing Then Exit Sub
  
  'Zielordner wählen
  Set Target = Application.Session.PickFolder
  If Target Is Nothing Then Exit Sub
  
  LoopFolders Source.Folders, Target.Folders, True
  MsgBox "fertig"
End Sub

Private Sub LoopFolders(SourceFolders As Outlook.Folders, _
  TargetFolders As Outlook.Folders, _
  ByVal Recursive As Boolean _
)
  Dim Source As Outlook.MAPIFolder
  Dim Target As Outlook.MAPIFolder
  Dim FolderType As OlDefaultFolders
  
  For Each Source In SourceFolders
    Select Case Source.DefaultItemType
      Case olAppointmentItem
        FolderType = olFolderCalendar
      Case olContactItem, olDistributionListItem
        FolderType = olFolderContacts
      Case olJournalItem
        FolderType = olFolderJournal
      Case olNoteItem
        FolderType = olFolderNotes
      Case olTaskItem
        FolderType = olFolderTasks
      Case Else
        FolderType = olFolderInbox
    End Select
    Set Target = TargetFolders.Add(Source.Name, FolderType)

    If Recursive Then
      LoopFolders Source.Folders, Target.Folders, Recursive
    End If
  Next
End Sub