VBOffice

Copy Folder Structure

This sample copies Outlook folders without their contents.

Last modified: 2017/12/17 | Accessed: 31.652  | #167
◀ Previous sample Next sample ▶
Category-Manager Category-Manager
With Category-Manager you can group your Outlook categories, share them with other users, filter a folder by category, automatically categorize new emails, and more. You can use the Addin even for IMAP.

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.


tip  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
ReplyAll ReplyAll
ReplyAll alerts you before unintentionally replying all, or if you are a confidential BCC recipient of the e-mail.
email  Send a message