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.

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
WScript.Quit
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

Next

'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
Err.Clear

End If

Next

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

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

Err.Clear
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)

Next

End Sub