Set Office Author with a script

Some time, our helpdesk guys do not set on Microsoft Office the Author name on options/general. Here a script to compile this option taking the name from logged-in account

On Error Resume Next
Const HKEY_CURRENT_USER = &H80000001

Dim WSHNetwork, oReg
Dim UserName, strKeyPath, strValueName, strValue
Dim BinValue,binUserName
Dim objSysInfo, objUser

Set oReg=GetObject("Winmgmts:Root/Default:StdRegProv")
Set objSysInfo = CreateObject("ADSystemInfo")
If objSysInfo.UserName <> 0 Then
    Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
    UserName = objUser.DisplayName
End If

If UserName = "" Then
    Set WSHNetwork = WScript.CreateObject("WScript.Network")
    UserName = WSHNetwork.UserName
End If

strKeyPath = "Software\Microsoft\Office\11.0\Common\UserInfo"
strValueName = "UserName"

oReg.GetBinaryValue HKEY_CURRENT_USER,strKeyPath,strValueName,binValue
strValue = BinaryToString(binValue)

If oReg.SetBinaryValue(HKEY_CURRENT_USER,strKeyPath,strValueName,StringToBinary(UserName)) <> 0 Then
    Wscript.Echo "Error Setting Registry Value"
End If

Function BinaryToString(val)
    Dim bByte, retval, i
    For i = 0 To UBound(val) Step 2
        bByte = val(i)
        If bByte <> "" Then retval = retval & Chr(bByte)
    BinaryToString = retval
End Function

Function StringToBinary(val)
    Dim index, i
    Dim retval
    index = -1
    For i = 1 To Len(val)
        retval = retval & AscW(Mid(val, i, 1)) & ",0,"
    retval = retval & "0,0"
    StringToBinary = Split(retval,",")
End Function

You can run this script every time a new user login to a computer.


Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s