I stuggled with this before
this scripts creates a reg file, and then imports the reg file. but you
could modify it to use regwrite,
there is a ref to my domnain and to a shared folder that you need to change
But you would be interested in the sub "hexDis" sub
on error resume next
dim network:Set network = CreateObject("WScript.Network")
dim user: user = network.UserName
dim fullName: fullName = getFullName(user)
Set usr = GetObject("WinNT://thatsIT.local/" & user)
getFullName = usr.Get("Fullname")
dim twoNames:twoNames = Split(fullName," ")
initials = Mid(twoNames(0),1,1)
if UBound(twoNames) => 1 then
initials = initials & Mid(twoNames(1),1,1)
hexDis "ThatsIT Solutions","Company"
' Convert ascii to hex and add "00"'s and commas
For i = 1 to Len(dis)
disHex = disHex & "," _
& Hex(Asc(Mid(dis, i, 1))) & ",00"
' Remove trailing comma
disHex = Right(disHex, Len(disHex) -1)
' Add terminating ",00,00"
disHex = disHex & ",00,00"
' Ready to create temporary registry file
Const OverwriteIfExist = true
Const FailIfExist = 0
Const OpenAsASCII = 0
Const OpenAsUnicode = -1
Const OpenAsDefault = -2
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Wscript.Shell")
sTmpFile = oShell.ExpandEnvironmentStrings("%TEMP%") & "\mso_usr.reg"
Set fFile = oFSO.CreateTextFile(sTmpFile, _
fFile.WriteLine "[HKEY_CURRENT_USER\Software\Microsoft\" _
fFile.WriteLine """"& valueToChange &"""=hex:" & disHex
' Import the registry file
oShell.Run "regedit /s " & sTmpFile, 0, True
if oFSO.FileExists(sTmpFile) then
"Graham Turner" <ipcomp1@xxxxxx> wrote in message
> dear all, was wondering if someone could offer a helping-hand with
> this script .
> the aim of the script is to automatically populate the Username
> registry value for Office 2003 such that it is prepopulated with data
> from AD and does not prompt the user.
> the AD query seems fine.
> however i have an issue with the writing of the reg_binary data in
> that would seem related to the data retrieved from AD, as if i hard-
> wire text into the 'strusername' variable all is well.(using the Ascii
> first up i have found that i need to use the 'unicode' function of the
> script to get any 'sensible' data in to the registry, which would seem
> related to the storage of the data in AD.
> when doing this the observed behaviour is for the script to enter
> registry data that is nearly correct, but non-printable chars appear
> in the User information dialog of the application.
> when we look at the binary data using regedit we are missing "00 00"
> from the hex data as compared to the data which yields correct user
> information as viewed in the office applications.
> I hope this makes sense. TIA
> script content follows.(feel free to offer mods !....
> On Error Resume Next
> 'this first section uses and we then , from which we derive the LDAP
> Set objSysInfo = CreateObject("ADSystemInfo")
> strUser = objSysInfo.UserName
> Set objUser = GetObject("LDAP://" & strUser)
> strName = objUser.FullName
> strTitle = objUser.Title
> strDepartment = objUser.Department
> strCompany = objUser.Company
> strPhone = objUser.TelephoneNumber
> Const HKEY_CURRENT_USER = &H80000001
> Const strPath = "Software\Microsoft\Office\11.0\Common\UserInfo"
> Dim objNet, ObjRegistry, strUserName, uBinary, Return
> Set objNet = CreateObject("WScript.NetWork")
> Set objRegistry = GetObject("Winmgmts:root\default:StdRegProv")
> strUserName = lcase(objNet.UserName)
> ' uBinary = Str2BinA(strUserName)
> uBinary = Str2BinU(strUserName)
> WScript.Echo Join(uBinary)
> Return = objRegistry.SetBinaryValue(HKEY_CURRENT_USER, strPath,
> "UserName", uBinary)
> If Return = 0 Then
> WScript.Echo "Binary value added successfully"
> ' An error occurred
> End If
> Function Str2BinA(Src) ' Ascii version
> Dim Tmp(), I, L
> L = Len(Src): ReDim Tmp(L - 1)
> For I = 1 To L: Tmp(I - 1) = Asc(Mid(Src, I)): Next
> Str2BinA = Tmp
> End Function
> Function Str2BinU(Src) ' Unicode version
> Dim Tmp(), I, L
> L = LenB(Src): ReDim Tmp(L - 1)
> For I = 1 To L: Tmp(I - 1) = AscB(MidB(Src, I)): Next
> Str2BinU = Tmp
> End Function