Outlook PST File Drive Mapping

This topic contains 2 replies, has 2 voices, and was last updated by Profile photo of Jeffrey Ritch Jeffrey Ritch 1 year, 8 months ago.

  • Author
    Posts
  • #31626
    Profile photo of Jeffrey Ritch
    Jeffrey Ritch
    Participant

    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

  • #31627
    Profile photo of Rob Simmers
    Rob Simmers
    Participant

    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

  • #31635
    Profile photo of Jeffrey Ritch
    Jeffrey Ritch
    Participant

    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

You must be logged in to reply to this topic.