Outlook PST File Drive Mapping

PowerShell Help
1

We are changing user home drive letters from F: to H: but have an issue where users are storing their PST folder(s) on their local drive C: and the network with drive letter F:. I have a script that changes the Outlook PST location from F: to H: but it is also changing the ones on C: to H: also.
If anyone can help figure out how to exclude any PST file(s) located on C:, D:, E: but include any other drive letter to the new required drive mapping of H:. That would be a big help. Until then, its all manual changes.
Yes, I know this isn’t PS, but if anyone has any VB scripting, that would help. Or have a PS to do the same thing.
Script below

'Map H Drive
On Error Resume Next
Dim objNetwork
Dim strDriveLetter, strRemotePath, strUserName
strDriveLetter = “H:”
strRemotePath = “\company.net\office\Admin\Home”
Set objNetwork = WScript.CreateObject(“WScript.Network”)

'Removes H Drive if it exists
objNetwork.RemoveNetworkDrive “H:”, True, True
WScript.Sleep 120

’ Maps new H Drive
strUserName = objNetwork.UserName
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath _
& "" & strUserName

'Read PST Files
Set objOutlook = createObject(“Outlook.Application”)
set objMAPI = objOutlook.GetNamespace(“MAPI”)
Dim pstFiles(5)
size = 0
For each PSTFolder In objMAPI.Folders
On Error Resume Next
pstPath = GetPath(PSTFolder.StoreID)

pstFiles(size) = pstPath
'WScript.echo pstFiles
size = size + 1

Next

Function GetPath(input)
for i = 1 To Len(input) Step 2
strSubString = Mid(input,i,2)
if Not strSubString = “00” Then
strPath = strPath & ChrW(“&H” & strSubString)
end If
next

select Case True
case InStr(strPath,“:") > 0
GetPath = Mid(strPath,InStr(strPath,”:")-1)
case InStr(strPath,“\”) > 0
GetPath = Mid(strPath,InStr(strPath,“\”))
end Select
end Function

WScript.Sleep 120

'Remove PST Files
Dim objOL 'As New Outlook.Application
Dim objFolders 'As Outlook.MAPIFolders
Dim objFolder 'As Outlook.MAPIFolder
Dim i 'As Interger
Dim strPrompt 'As String

Set objOL = CreateObject(“Outlook.Application”)
Set objFolders = objOL.Session.Folders
For i = objFolders.Count To 1 Step -1
On Error Resume Next
Set objFolder = objFolders.Item(i)

'Prompt the user for confirmation
If (InStr(1, objFolder.Name, "Mailbox") = 0) And (InStr(1, objFolder.Name, "Public Folders") = 0) Then

   objOL.Session.RemoveStore objFolder

End If

Next

WScript.Sleep 120

'Strip old drive letter out of array and add drive letter H in it’s place
'Then add pst file to Outlook
For Each file In pstFiles

A1 = Split(file, vbCrLf) '--create an array of lines.
For i = 0 to UBound(A1)
	s2 = A1(i)
  If Len(s2) > 0 then '-- avoid errors on blank lines.
	 s2 = Right(s2, (Len(s2) - 1))
	 A1(i) = s2
  End If
file = Join(A1,vbCrLf)
newPST = "H" & file
objMAPI.AddStore newPST
Next

Next

2

Firstly, this script makes puppies cry with On Error Resume Next set globally, the same objects being created multiple times with different variable names and using two different methods to enumerate the folders.

Rather than guess at what local or network drives are, you should use WMI’s Win32_LogicalDisk to identify either local drives to exclude or network drives to process. Unless you want the script rewritten in Powershell, I highly recommend using a visual basic scripting forum, I used to contribute here which appears to still be active:

http://www.visualbasicscript.com/WSH-Client-Side-VBScript-f2.aspx

3

Work and verified. Below is the complete VBScript.

'Map H Drive
On Error Resume Next
Dim objNetwork
Dim strDriveLetter, strRemotePath, strUserName
strDriveLetter = “H:”
strRemotePath = “\company.net\office\Admin\Home”
Set objNetwork = WScript.CreateObject(“WScript.Network”)
'Removes H Drive if it exists
objNetwork.RemoveNetworkDrive “H:”, True, True
WScript.Sleep 120
’ Maps new H Drive
strUserName = objNetwork.UserName
objNetwork.MapNetworkDrive strDriveLetter, strRemotePath _
& "" & strUserName

'Read PST Files
Set objOutlook = createObject(“Outlook.Application”)
set objMAPI = objOutlook.GetNamespace(“MAPI”)
Dim pstFiles(10)
size = 0
For each PSTFolder In objMAPI.Folders
On Error Resume Next
pstPath = GetPath(PSTFolder.StoreID)

pstFiles(size) = pstPath
'WScript.echo pstFiles
size = size + 1
Next
Function GetPath(input)
for i = 1 To Len(input) Step 2
strSubString = Mid(input,i,2)
if Not strSubString = “00” Then
strPath = strPath & ChrW(“&H” & strSubString)
end If
next
select Case True
case InStr(strPath,“:") > 0
GetPath = Mid(strPath,InStr(strPath,”:")-1)
case InStr(strPath,“\”) > 0
GetPath = Mid(strPath,InStr(strPath,“\”))
end Select
end Function
WScript.Sleep 120
'Remove PST Files
Dim objOL 'As New Outlook.Application
Dim objFolders 'As Outlook.MAPIFolders
Dim objFolder 'As Outlook.MAPIFolder
Dim i 'As Interger
Dim strPrompt 'As String

Set objOL = CreateObject(“Outlook.Application”)
Set objFolders = objOL.Session.Folders
For i = objFolders.Count To 1 Step -1
On Error Resume Next
Set objFolder = objFolders.Item(i)

'Prompt the user for confirmation 
If (InStr(1, objFolder.Name, "Mailbox") = 0) And (InStr(1, objFolder.Name, "Public Folders") = 0) Then 

   objOL.Session.RemoveStore objFolder 

End If

Next
WScript.Sleep 120
'Strip old drive letter out of array and add drive letter H in it’s place
'Then add pst file to Outlook
For Each file In pstFiles
A1 = Split(file, vbCrLf) '–create an array of lines.
For i = 0 to UBound(A1)
s2 = A1(i)
If Len(s2) > 0 then '– avoid errors on blank lines.
'filter out paths containing the driveletters c,d,e
'for other driveletters, replace the driveletter with H
Select Case UCase(Left(s2,1))
Case “C”, “D”, “E”
'no change for these driveletters
Case Else
s2 = Right(s2, Len(s2) - 1)
A1(i) = “H” & s2
End Select
End If
Next
file = Join(A1,vbCrLf)
newPST = file 'newPST no longer adds “H” infront of file, “H” is now added to A1 above before the join
objMAPI.AddStore newPST
Next