Prefill Office User Info With Domain Username HELP!

[drweb]

Hey All,
I have been scouring the net for weeks on how to get a users name from active directory, convert it to hexadecimal, and throw it into the registry to set the Office User Info feilds through a logon script.
I can only get this wo work with my agents who are on mandatory profiles, which I am thankful for. But, I can not get this to work for all my other users in the domain who use regular profiles.
Can someone take a look at this and provide some insight and or correction if any.
Here is my script that does this.

On Error Resume Next
'-----------------
'Declaring Variables
'-----------------

Dim oUser
Dim oReg
Dim oSysInfo
Dim sUsername
Dim sComputer
Dim iIndex
Dim iPos
Dim aUserName
Dim sKeyPath
Dim sValueName
Dim iRC


'*********************************************
' Set Microsoft Office User
'*********************************************

sUsername = oUser.GivenName + " " + oUser.sn

Const HKCU = &H80000001

sComputer = "." ' Office username to be written to registry

aUsername = ToByteArray(sUsername)

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sComputer & "\root\default:StdRegProv")

sKeyPath = "SOFTWARE\MICROSOFT\OFFICE\8.0\COMMON\USERINFO\"

sValueName = "UserName"

iRC = oReg.SetBinaryValue(HKCU, sKeyPath, sValueName, aUsername)

'If iRC <> 0 Then
' 'An error occurred
' WScript.Echo "Error, return code: " & iRC
'End If


Function ToByteArray(ByVal sString)

ReDim aBytes(Len(sString) * 2 + 1)

iIndex = -1
For iPos = 1 To Len(sString)
iIndex = iIndex + 1
aBytes(iIndex) = Asc(Mid(sString, iPos, 1))
' add a 0 after each letter
iIndex = iIndex + 1
aBytes(iIndex) = 0
Next

' add two closing 0's
iIndex = iIndex + 1
aBytes(iIndex) = 0
iIndex = iIndex + 1
aBytes(iIndex) = 0

ToByteArray = aBytes
End Function

 

[PHV]

And what about something like this ?
Set N = WScript.CreateObject("WScript.Network")
While sUserName = ""
sUserName = N.UserName
WEnd
Set W = WScript.CreateObject("Word.Application")
W.UserName = sUserName
W.Quit
Set W = Nothing

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[tsuji]

Hello drweb,

Just briefly look at your script. As to the data filled into the registry, this is the modification I propose.
[tt]
For iPos = 1 To Len(sString)
iIndex = iIndex + 1
aBytes(iIndex) = [blue]cbyte[/blue](Asc(Mid(sString, iPos, 1)))
' add a 0 after each letter
iIndex = iIndex + 1
aBytes(iIndex) = [blue]cbyte[/blue](0)
Next

' add two closing 0's
iIndex = iIndex + 1
aBytes(iIndex) = [blue]cbyte[/blue](0)
iIndex = iIndex + 1
aBytes(iIndex) = [blue]cbyte[/blue](0)
[/tt]
(An array of bytes is not exactly a byte-array. But, that's only a detail... Maybe this will work for you.)

regards - tsuji

 

[drweb]

Thanks to both of you. Both fixes worked for my situation.