I was recently working on a large migration project in which we had to clean the users profiles.

To ease Users experience, we had to develop a way to avoid the eternal first run Microsoft Office Popup asking for Username, Company and Initials.

As these settings relies on reg values, this could be easy to define them by logon script.

However, as they are hardcoded within reg binaries values, scripting these settings is not as simple as it could have been.

The following script relies on the StringToRegBinary() function to do this job : getting an input string an converting it to a REG_BINARY value.

It'll then get the UserName (the simple Username, although the script can be modified to get First and Last Names) and take the first Username Letter for the initials.

You can use it "as is" or include its functions into your login script if any.

By Default, all activity is logged at the User's Profile Root.

'-------------------------------------------------------------------

Const sCompanyName = "CitrixTools.Net"
Const HKEY_CURRENT_USER = &H80000001
Const strOfficeRegPath = "Software\Microsoft\Office\10.0\Common\UserInfo"
Const LogFileName = "SetOfficeUserInfos.Log"

Set WshShell = WScript.CreateObject("WScript.Shell")
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set ObjReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Set WshNetwork = WScript.CreateObject("WScript.Network")

LogFile = WshShell.ExpandEnvironmentStrings("%USERPROFILE%\" & LogFileName)

Username = WshNetwork.UserName

SetOfficeUserInfos()

Private Sub WriteLog(Message)
 On Error Resume Next
 Err.Clear
 Set objLogFile = ObjFSO.OpenTextFile(LogFile, 8, True)
 objLogFile.Write date & Space(1) & time & Space(1) & Message & VbCrlf
 objLogFile.Close
End Sub

Private Sub SetOfficeUserInfos()
    on error resume next
    err.clear
 If DoRegKeyExists(HKEY_CURRENT_USER, strOfficeRegPath) then
  uBinary = StringToRegBinary(sCompanyName)
  uBinary2 = StringToRegBinary(Left(Username,1))
  uBinary3 = StringToRegBinary(Username)
   If Not DoRegValueExists(HKEY_CURRENT_USER, strOfficeRegPath, "Company") then
    Return = ObjReg.SetBinaryValue(HKEY_CURRENT_USER, strOfficeRegPath, "Company", uBinary)
   End If
   If Not DoRegValueExists(HKEY_CURRENT_USER, strOfficeRegPath, "UserInitials") then
    Return = ObjReg.SetBinaryValue(HKEY_CURRENT_USER, strOfficeRegPath, "UserInitials", uBinary2)
   End If
   If Not DoRegValueExists(HKEY_CURRENT_USER, strOfficeRegPath, "UserName") then
    Return = ObjReg.SetBinaryValue(HKEY_CURRENT_USER, strOfficeRegPath, "UserName", uBinary3)
   End If
 Else
  writeLog "SetOfficeUserInfos: Warning: " & "HKEY_CURRENT_USER\" & strOfficeRegPath & " Not Found "
 End If
   If err then
    writeLog "SetOfficeUserInfos: ERROR: " & err.number & " -> " & err.description
   else
    writeLog "SetOfficeUserInfos: OK: "
   End If
End Sub

Private Function StringToRegBinary(inputString)
    on error resume next
    err.clear
 Dim intCounter , intCounterLen , intLen , arrHex()
 intLen = Len(inputString)-1
 ArrLen = Len(inputString) * 2 + 2
 redim arrHex(ArrLen - 1)
 intCounterLen = 0
 For intCounter = 0 to intLen * 2 Step 2
  arrHex(intCounter) = Asc(Mid(inputString, intCounterLen + 1,1))
  arrHex(intCounter + 1) = 0
  intCounterLen = intCounterLen + 1
 Next
 arrHex(ArrLen - 2) = 0
 arrHex(ArrLen - 1) = 0
 StringToRegBinary = arrHex
 If err then
                writeLog "StringToRegBinary: ERROR:" & err.number & " -> " & err.description
 Else
  writeLog "StringToRegBinary: OK:" & inputString & " : " & Join(arrHex,",")
        End If
End Function

Private Function DoRegKeyExists(sHive, sRegKey)
 On Error Resume Next
 Err.clear
 DoRegKeyExists = False
 Dim aValueNames, aValueTypes
  If ObjReg.EnumValues(sHive, sRegKey, aValueNames, aValueTypes) = 0 Then
   DoRegKeyExists = True
  Else
   DoRegKeyExists = False
  End If
 if err then
          WriteLog "DoRegKeyExists: ERROR : " & err.number & " -> " & err.description
    WriteLog ""
 End If
End Function

Private Function DoRegValueExists(sHive, sRegKey, sRegValue)
 On Error Resume Next
 Err.Clear
 Dim aValueNames, aValueTypes
 DoRegValueExists = False   ' init value
 If ObjReg.EnumValues(sHive, sRegKey, aValueNames, aValueTypes) = 0 Then
  If IsArray(aValueNames) Then
   For i = 0 To UBound(aValueNames)
    If LCase(aValueNames(i)) = LCase(sRegValue) Then
     DoRegValueExists = True
    End If
   Next
  End If
 End If
 if err then
          WriteLog "DoRegValueExists: ERROR : " & err.number & " -> " & err.description
    WriteLog ""
 End If
End Function

Public Function DoRegKeyExists(sHive, sRegKey)
 On Error Resume Next
 Err.clear
 DoRegKeyExists = False
 Dim aValueNames, aValueTypes
  If ObjReg.EnumValues(sHive, sRegKey, aValueNames, aValueTypes) = 0 Then
   DoRegKeyExists = True
  Else
   DoRegKeyExists = False
  End If
 if err then
          WriteLog "DoRegKeyExists: ERROR : " & err.number & " -> " & err.description
    WriteLog ""
 End If
End Function
Public Function DoRegValueExists(sHive, sRegKey, sRegValue)
 On Error Resume Next
 Err.Clear
 Dim aValueNames, aValueTypes
 DoRegValueExists = False   ' init value
 If ObjReg.EnumValues(sHive, sRegKey, aValueNames, aValueTypes) = 0 Then
  If IsArray(aValueNames) Then
   For i = 0 To UBound(aValueNames)
    If LCase(aValueNames(i)) = LCase(sRegValue) Then
     DoRegValueExists = True
    End If
   Next
  End If
 End If
 if err then
          WriteLog "DoRegValueExists: ERROR : " & err.number & " -> " & err.description
    WriteLog ""
 End If
End Function

'-------------------------------------------------------------------

Update : Sample code to get Full Username and Initials

Lines to add at the beginning of the main script

Set objSysInfo = CreateObject("ADSystemInfo")

strUser = objSysInfo.UserName

Set objUser = GetObject("LDAP://" & strUser)

Lines to modify within the main script

Username = objUser.givenName & " " & objUser.SN

uBinary = StringToRegBinary(sCompanyName)

uBinary2 = StringToRegBinary(Left(objUser.givenName,1) & Left (objUser.SN,1) )

uBinary3 = StringToRegBinary(Username)