Update PST file location on Logon via Script

Script to update PST File locationsBookmark:Question:
We are running a project to migrate the backend file location for 1000 user created PST files to a new 2008 File server. The server will not re-use the previous server name and we will not be able to use a DNS alias for the old server to point to the new one.

Users have historically used personal folders stored in their networked homedrives (Yes, we know it is not a Microsoft best practise methodology for PST file usage) and we are planning to move all pst files to a decidated PST file server and then update the path location to the pst files with no user impact or intervention.

I am looking at implementing a logon script to remap the pst file to the new location. The workflow will be as follows

Nighttime (After backups complete) robocopy pst files from \\oldserver\homedrive$ to \\newserver\pstdir$
Remove permissions to the source PST file
On user logon - map new network drive (P:\ to the \\newserver\pstdir$ directory (this will be a security locked down folder based on the user's name)
Logon script to query the registry or mapi profile of the user and for every pst file connected (Some users have more than 1) change the path from M:\ (current user homedrive mapping) to P:\ (preserving the rest of the path, for example if a user had M:\MyMail\October-Archive.pst file then the remap should be P:\MyMail\October-Archive.pst)

I am ok for the 1st parts of the problem, but I am stuck on the Logon script, as the value stored in the registry is a hexidecimal string. So I need to query all outlook profiles for the user, compile an array of pst file string locations, decode the strings, rewrite the new path, encode the string and write it back.

I have found a few scripts on the net that in part achieve some aspects of this, but nothing that provides a complete solution.

Mapi profile information is stored in the registry here "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"

The key name for a PST file is either "01020fff" "001f6700" (Example below)

HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Default Outlook Profile\93abdcf58c80884b92c1b8c1b272dc12
    01023414    REG_BINARY    4E495441F9BFB80100AA0037D96E0000
    001f300a    REG_BINARY    6D0073007000730074002E0064006C006C000000
    001f3d13    REG_BINARY    7B00360034003800350044003200360032002D0043003200410043002D0031003100440031002D0041004400330045002D003100300041003000430039003100310043003900430030007D000000
    00033e03    REG_BINARY    21000000
    00033009    REG_BINARY    00000000
    001f3001    REG_BINARY    50006500720073006F006E0061006C00200046006F006C0064006500720073000000
    001f3006    REG_BINARY    50006500720073006F006E0061006C00200046006F006C0064006500720073000000
    01023d0c    REG_BINARY    2BDB2EC4365E81428904AB3D06E7FD3E
    001f3d09    REG_BINARY    4D005300550050005300540020004D0053000000
    00036770    REG_BINARY    00000080
    00036702    REG_BINARY    00000010
    01020fff    REG_BINARY    0000000038A1BB1005E5101AA1BB08002B2A56C200006D737073742E646C6C00000000004E495441F9BFB80100AA0037D96E0000000043003A005C00540065006D0070005C00540065007300740031002E007000730074000000
    001f6700    REG_BINARY    43003A005C00540065006D0070005C00540065007300740031002E007000730074000000
    001f3004    REG_BINARY    0000
    01020ff9    REG_BINARY    636E08EC45E2F449AB50A4F2AB97DDF3
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ServerManagementTeamAuthor Commented:
I have made a bit of headway with this and I can enumerate the PST files that match a criteria. However, I am now stuck on writing the translated value back to the registry. Code snip below

Example output below

Microsoft (R) Windows Script Host Version 5.8
Copyright (C) Microsoft Corporation. All rights reserved.

D:\Mail\Test.pst  Does not need to be remapped
PST Found at location  M:\Test\Test.pst
Translating occurence of M:\ to P:\ - New location is now  P:\Test\Test.pst
Translating  P:\Test\Test.pst To HEX value to add to the Registry, new value is  50 3A 5C 54 65 73 74 5C 54 65 73 74 2E 70 73 74 0

Option Explicit
Dim go_fso, go_outlook, go_namespace         
Dim gl_folders, gl_files, gl_psts                        
Dim strNewText
Call s_init()
Call s_main()
Sub s_init()
  Set go_fso = CreateObject( "Scripting.FileSystemObject" )
  Set go_outlook = CreateObject( "Outlook.Application" )
  Set go_namespace = go_outlook.GetNameSpace( "MAPI" )
End Sub
Sub s_main()
  Const cs_fac = "%s_main, "
  Dim lo_folder, ls_path                            
  For Each lo_folder In go_outlook.Session.Folders
        ls_path = GetStorePath( lo_folder.StoreID )
   		Dim str1
    	Dim str2
    	Dim arrStr
    	Dim oReg
       	arrStr = Split(ls_path, ":", -1,1)
    	str1 = UCase(arrStr(0))
     	str2 = UCase("M")
		If str1 = str2 Then
		strNewText = Replace(ls_path, "M:\", "P:\")
		WScript.Echo "PST Found at location ", ls_path & vbCrLf
    	WScript.Echo "Translating occurence of M:\ to P:\ - New location is now ", strNewText & vbCrLf
		WScript.Echo "Translating ", strNewText, "To HEX value to add to the Registry, new value is ", StringToHex4(strNewText) & vbCrLf
		Dim StringForArray
		StringForArray = Replace(StringToHex4(strNewText), " ", ",00,")
		WScript.Echo StringForArray
		WScript.Echo ls_path, " Does not need to be remapped"
		End If
End Sub
Function GetStorePath(strStoreID)
    Dim intStart
    Dim intEnd
    Dim strProvider
    Dim strPathRaw
    intStart = InStr(9, strStoreID, "0000") + 4
    intEnd = InStr(intStart, strStoreID, "00")
    strProvider = Mid(strStoreID, intStart, intEnd - intStart)
    strProvider = Hex2ToString(strProvider)
    Select Case LCase(strProvider)
        Case "mspst.dll", "pstprx.dll"
            If Right(strStoreID, 6) = "000000" Then
                intStart = InStrRev(strStoreID, "00000000") + 8
                strPathRaw = Mid(strStoreID, intStart)
                GetStorePath = Trim(Hex4ToString(strPathRaw))
                intStart = InStrRev(strStoreID, "000000") + 6
                strPathRaw = Mid(strStoreID, intStart)
                GetStorePath = Trim(Hex2ToString(strPathRaw))
            End If
        Case "msncon.dll"
            intStart = InStrRev(strStoreID, "00", Len(strStoreID) - 2) + 2
            strPathRaw = Mid(strStoreID, intStart)
            GetStorePath = Trim(Hex2ToString(strPathRaw))
        Case "emsmdb.dll"
            GetStorePath = "Exchange store"
        Case Else
            GetStorePath = "Unknown store path"
    End Select
End Function
Public Function Hex4ToString(Data)
    Dim strTemp
    Dim strAll
    Dim i
    For i = 1 To Len(Data) Step 4
        strTemp = Mid(Data, i, 4)
        strTemp = "&H" & Right(strTemp, 2) & Left(strTemp, 2)
        strAll = strAll & ChrW(Eval(strTemp))
    Hex4ToString = strAll
End Function
Public Function Hex2ToString(Data)
    Dim strTemp
    Dim strAll
    Dim i
    For i = 1 To Len(Data) Step 2
        strTemp = "&H" & Mid(Data, i, 2)
        strAll = strAll & ChrW(Eval(strTemp))
    Hex2ToString = strAll
End Function
Public Function StringToHex4(Data)
	Dim i, sVAL
	For i = 1 To Len(Data) 
	sVAL = sVAL & Hex(Asc(Mid(Data,i,1))) & " "
	StringToHex4 = sVAL
End Function
Public Function WriteValue(Data)
Const HKEY_CURRENT_USER = &H80000001
Dim objRegistry, strPath, uBinary, Return
Set objRegistry = GetObject("Winmgmts:root\default:StdRegProv")
strPath = "Software\MyKey"
uBinary = Data
Return = objRegistry.SetBinaryValue(HKEY_CURRENT_USER, strPath, "MyBinaryNamedValue", uBinary)
If (Return = 0) And (Err.Number = 0) Then
    Wscript.Echo "Binary value added successfully"
    ' An error occurred
End If
End Function
Public Function WriteValue(Data)
Const HKEY_CURRENT_USER = &H80000001
Dim strComputer
Dim strKeyPath
Dim strValueName
Dim arrValues
Dim errReturn
Dim objRegistry
strComputer = "."
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
strKeyPath = "Software"
strValueName = "BinaryTest"
arrValues = Array(Data)
errReturn = objRegistry.SetBinaryValue (HKEY_CURRENT_USER, strKeyPath, strValueName, arrValues)
End Function

Open in new window

Hi there,

I haven't used the SetBinaryValue method that much and I can't test it out just yet...

But, would it be easier to write a .reg file with the script, and include your binary string in that reg file, then use the Run method of the WScript.Shell object to run
regedit / s <regfilepath>

Would that work?


ServerManagementTeamAuthor Commented:
The problem though is that the script as it is does not give me the registry path of where to write the value back to.

Function GetStorePath(strStoreID)
 returns PST file paths, but it does not query the registry directly, instead it calls two dlls to get the info store path, but that does not return the full registry path for me to translate and write back
Hmmm, if you're only moving the PST files in the bacfground, then perhaps the code from here can help:

It's built to run in a Microsoft Macro of some sort, preferably an Outlook macro I would guess.  It has DetachPST, MoveFiles, and AttachPST functions, that may suit what you're looking for.



Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Windows Networking

From novice to tech pro — start learning today.