Code Script

Home | Scripts | Tutorials | Disclaimer | Sitemap | Contact

   Create Mailbox Folders In Pst File

Vbscript / Ms Office / Create Mailbox Folders In Pst File

A script for replicating the Outlook folder structure within
PST files with the mailbox. Any folder structure within all
open PST files will be recreated within the mailbox root.
The PST files and existing mailbox folder structure are not affected.

On Error Resume Next

Set objShell = WScript.CreateObject("WScript.Shell")
Set oOutlook = GetObject(, "Outlook.Application")
Set oNameSpace = oOutlook.GetNamespace("MAPI")

msgText = "Do you want to copy the existing folder structure in your Personal Folders to your mailbox? To continue ensure that Outlook is open and all the required Personal Folders are shown in the folder list."
retVal = objShell.Popup(msgText,200,"Confirm",vbQuestion + vbYesNo)

If retVal = vbNo Then
End If

Set allMail = oNamespace.folders

'Folder creation count
Count = 0

'Address top level folders
For Each Folder in allMail

'Detect Mailbox and Public folders by name
fName = Folder.Name
isMbox =  InStr(1, fName, "Mailbox")
isPub =  InStr(1, fName, "Public Folders")

'Record Mailbox
If isMbox <> 0 Then
Set MboxRoot = Folder
'WScript.Echo "Got Mailbox" & MBoxRoot
End If


'Address top level folders
For Each Folder in allMail

fName = Folder.Name
isMbox =  InStr(1, fName, "Mailbox")
isPub =  InStr(1, fName, "Public Folders")

'Find PST files
If isMbox + isPub = 0 Then
Set MBox = MBoxRoot

'Test access to PST
Set test = Folder.Folders

'PST access OK
If Err.Number = 0 then

'Run copyfolders for PST file
copyFolders Folder, MBox

End If

End If


WScript.Echo "Complete. Folders created: " & Count

If Err.Number <> 0 Then
msg = "PreBackup script failed: " & Err.Description
objShell.LogEvent 1, msg
End If

On Error GoTo 0

Set objShell = nothing
Set oOutlook = Nothing
Set oNameSpace = Nothing

'Copy folder structure
Sub copyFolders(PST, MBox)
On Error Resume Next

For Each Folder in PST.Folders

Set NewFolder = MBox.Folders.Add(Folder.Name)

'WScript.Echo Folder.Name & " -> " & MBox.Name

If Err.Number = 0 Then
'WScript.Echo Folder.Name & " - " & Err.Description
Count = Count + 1
End If

copyFolders Folder, MBox.Folders(Folder.Name)


End Sub

Please note that a disclaimer applies to any code on this page.
  Go Back
  Print Page

- Links
- Reference
- Script Editors
- Tutorials
- Vbscript
     - Active Directory
     - Exchange
     - Files And Folders
     - General
     - Ms Office
          - Create Email In Mailbox
          - Create Email With Past Date
          - Create Mailbox Folders In Pst File
          - Find Acronyms In Word Document
          - Outlook Autocomplete Import
          - Read Data From Spreadsheet
          - Read Word Document
          - Word Edit User Properties
          - Word File Save Location
          - Word Hide Toolbar
          - Word Template Location
     - Operating System
     - Processes And Services
     - Text Processing
     - User Interaction
     - Web Servers