[RESOLVED] Modify PST location in registry! Need Help!

Here's the dillema. We will be migrating a lot of users from physical desktops to virtual desktops. So naturally, we need to move any pst files from the local file system to the storage system which is the easy part.

Where I am currently struggling is figuring out how to modify the 001f6700 REG_BINARY value to reflect the new location of the pst file(s). :sick:

So, the function I am trying to use is shown below. When I run the script the SetBinaryValue method runs and generates no errors but the value still shows the local path and appears to be untouched by the script. Based off of some posts I have been reading I may not be formating the data within arrBinaryValueName properly before using the SetBinaryValue method.

Any help would be greatly appreciated. Apologies if an answer to this has already been posted but I have been searching all over the inet and only found a few treads talking about this specific issue.

Bryan

Code:

---

Function WriteNewLocation(strWriteKey)
        Dim newAsciiName, arrBinaryValueName
        strSplitter = Split(strWriteKey, ";", -1, 1)
        PSTFileNameOld = LCase(strSplitter(0))
        p_PSTRGuidReg = strSplitter(1)
        objPSTLog.WriteLine(p_PSTRGuidReg)

        strArray = Split(PSTFileNameOld, "\")
                For Each arr In strArray
                        If InStr(arr, ".pst") Then
                                strFileName = arr
                        End If
                Next
               
        BinaryValueName = strServer & strFileName
        MsgBox BinaryValueName
       
        If InStr(PSTFileNameOld,strFile) <> 0 Then
                BinaryValueName = Replace(PSTFileNameOld,PSTFileNameOld,BinaryValueName)
        End If
       
        objPSTLog.WriteLine "Now fixing " & BinaryValueName

        max = len(BinaryValueName)
        For intLoop = 1 to Max step 1        'convert to ascii
                asciiName = asc(mid(BinaryValueName, intLoop, 1))
                If newAsciiName = ""  and newAsciiInitials = "" Then
                        newAsciiName = asciiName
                Else
                        newAsciiName = newAsciiName & "," & "00" & "," & asciiName
                End If
                If intLoop <= 2 then
                        newAsciiInitials = newAsciiName & "," & "00"
                End If
        Next
       
        newAsciiName = newAsciiName & "," & "00," & "00," & "00"
        newAsciiName = Replace(newAsciiName, "\", "")        'remove "\"
        newAsciiName = Replace(newAsciiName, vbCr, "")        'remove Cr and Lf separately, in case return is not vbCrLf
        newAsciiName = Replace(newAsciiName, vbLf, "")
        newAsciiName = "&H"&Replace(newAsciiName, ",", ",&H")
        If Right(newAsciiName, 1) = "," Then
                newAsciiName = Left(newAsciiName, (len(newAsciiName) - 1))        'Remove any trailing comma
        End If
        MsgBox newAsciiName
       
        arrBinaryValueName = Split(newAsciiName,",")        'convert to an array

        strMoniker = "winMgmts:\\.\root\default:StdRegProv"
        Set oReg1 = GetObject(strMoniker)
        strPSTEnd = oReg1.SetBinaryValue(HKEY_CURRENT_USER, strSplitter(1), r_PSTFile, arrBinaryValueName)        'Change the binary value
                If (Return = 0) And (Err.Number = 0) Then
                        WScript.Echo "Binary value changed successfully!"
                Else
                        WScript.Echo Err.Number & " " & Err.Description
                End If
        On Error Resume Next
        objPSTLog.WriteLine "Deleting value: HKEY_CURRENT_USER\" & strSplitter(1) & "\01020fff"
        oReg1.DeleteValue HKEY_CURRENT_USER, strSplitter(1), r_PSTFile2
 End Function

---

One other point which might help someone help me. At the end of the function I am attempting to delete the 01020fff REG_BINARY value using the DeleteValue method. This also is not working.

The issue was two-fold here. First, the SetBinaryValue method (line 227) was using strSplitter(1) for the subkey which included the users SID in the path. The second problem was even after being able to modify the binary value Outlook would still error when trying to open the pst. The last piece of the puzzel was to add three sets of 00 to the end of the ascii variable (line 221). Modified function is included below. Hopefully this will help others who need to migrate pst files.

Code:

---

Function WriteNewLocation(strWriteKey)
        Dim newAsciiName, arrBinaryValueName
        strSplitter = Split(strWriteKey, ";", -1, 1)                'Split into 3 values using the ; character
        PSTFileNameOld = LCase(strSplitter(0))                'Change any capitalized characters to lowercase
        p_PSTRGuidReg = strSplitter(1)
        arrPSTPath = Split(p_PSTRGuidReg, "\", 2)                'Split the GUID path into 2 values
        p_PSTPath = arrPSTPath(1)                'Set value to second value in array which begins with Software\Micros...
        objPSTLog.WriteLine(p_PSTRGuidReg)

        strArray = Split(PSTFileNameOld, "\")                'Split the existing pst path into an array using the \ character.
                For Each arr In strArray
                        If InStr(arr, ".pst") Then
                                strFileName = arr                'Set value for the pst file name
                        End If
                Next
               
        BinaryValueName = strServer & strFileName                'Add the server path and the pst file name to the value
       
        If InStr(PSTFileNameOld,strFile) <> 0 Then
                BinaryValueName = Replace(PSTFileNameOld,PSTFileNameOld,BinaryValueName)        'Replace the C: path with the UNC path.
        End If
       
        objPSTLog.WriteLine "Now fixing " & BinaryValueName

        max = len(BinaryValueName)
        For intLoop = 1 to Max step 1       
                asciiName = asc(mid(BinaryValueName, intLoop, 1))                'convert string to ascii
                If newAsciiName = ""  and newAsciiInitials = "" Then
                        newAsciiName = asciiName
                Else
                        newAsciiName = newAsciiName & "," & "00" & "," & asciiName                'Add 0's between data
                End If
                If intLoop <= 2 then
                        newAsciiInitials = newAsciiName & "," & "00"
                End If
        Next
       
        newAsciiName = newAsciiName & "," & "00" & "," & "00" & "," & "00"                'Add 0's to the end of the binary values or Outlook will not be able to open the pst file(s)!
       
        arrBinaryValueName = Split(newAsciiName,",")        'Split using comma as a dellimiter. Note SetBinaryValue does not accept dynamic array data!
       
        strMoniker = "winMgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\default:StdRegProv"
        Set oReg1 = GetObject(strMoniker)
        oReg1.SetBinaryValue HKEY_CURRENT_USER, p_PSTPath, PSTFile, arrBinaryValueName                'Change the 001f6700 value.
                If (Return = 0 And Err.Number= 0) Then
                        objPSTLog.WriteLine("001f6700 binary value changed successfully!")
                Else
                        objPSTLog.WriteLine("Failed to change binary value 001f6700!")
                        objPSTLog.WriteLine("Error was " & Err.Number & " - " & Err.Description)
                End If
        objPSTLog.WriteLine "Deleting value: HKEY_CURRENT_USER\" & p_PSTPath & "\01020fff"
        oReg1.DeleteValue HKEY_CURRENT_USER, p_PSTPath, r_PSTFile2                'Delete the 01020fff value.  Value will be recreated the next time Outlook is ran.
                If (Return = 0 And Err.Number= 0) Then
                        objPSTLog.WriteLine("01020fff binary value deleted successfully!")
                Else
                        objPSTLog.WriteLine("Failed to delete binary value 01020fff!")
                        objPSTLog.WriteLine("Error was " & Err.Number & " - " & Err.Description)
                End If
 End Function

---

This is exactly what I have been looking for!

Even thought this post is old, maybe hortonbo will still get this. Do you have a copy of the complete script that you could share?

Thanks!

Quote:

---

Originally Posted by neimadpc

This is exactly what I have been looking for!

Even thought this post is old, maybe hortonbo will still get this. Do you have a copy of the complete script that you could share?

Thanks!

---

I hate to resurrect an old thread (again) but wanted to give Neimadpc (and anyone else who happens to stumble upon this) a somewhat complete script for this. I've worked from Hortonbo's script above to create this: http://community.spiceworks.com/scri...-path-registry

It's based on the same ideas, but with a few modifications. HTH!