Update PST file location on Logon via Script

Option Explicit
Dim go_fso, go_outlook, go_namespace         
Dim gl_folders, gl_files, gl_psts                        
Dim strNewText
Call s_init()
Call s_main()
WScript.Quit(0)
 
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
		WriteValue(StringForArray)
		Else
		WScript.Echo ls_path, " Does not need to be remapped"
		End If
		Next
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
                '2003
                intStart = InStrRev(strStoreID, "00000000") + 8
                strPathRaw = Mid(strStoreID, intStart)
                GetStorePath = Trim(Hex4ToString(strPathRaw))
            Else
                '97
                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))
    Next
    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))
    Next
    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
Next
 
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"
Else
    ' 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
                                              

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150: