|OLKeeper reliably prevents users from closing their Outlook window and thus possibly missing reminders or e-mails.|
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.
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