Copy Folder Structure

There´s no feature in Outlook to copy only folders without their contents. This macro does exactly that, it copies a folder structure without contents. That saves you a lot of clicks if you want to reuse a folder hierarchy, for instance, for another project.

Start the macro 'CopyFolders', for instance, by pressing alt+f8. First select the source folder, that is the one which subfolders you want to copy, then select the target folder. That´s it, the rest will be done by the macro for you.

  How to add macros to Outlook

Public Sub CopyFolders()
  Dim Source As Outlook.Folder
  Dim Target As Outlook.Folder
  
  'select source folder
  Set Source = Application.Session.PickFolder
  If Source Is Nothing Then Exit Sub
  
  'select target folder
  Set Target = Application.Session.PickFolder
  If Target Is Nothing Then Exit Sub
  
  LoopFolders Source.Folders, Target.Folders, True
  MsgBox "done"
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