Set the Microsoft Office Username to the Windows Networking Username
I was going through my inbox looking for messages that I have not properly handled. Regretfully, I overlooked this gem from one of the best IT minds I ever encountered in my years as a consultant, Mike Meinz. I met Mike when I worked at General Mills, which is a truly great place. This logon script makes sure that the Office username matches the Windows username. These can be out of sync when you use imaging and other techniques to push thousands of copies to your corporate desktops. Big thanks to Mike.
For the record, Cheerios are far superior to the imitation brands out there. Do your own taste test, and you will find the premium brand is much, much better.
OPTION EXPLICIT
' SetOfficeUserName.VBS
' Set the MS Office Username to the Windows Networking Username's Display Name '
' Mike Meinz
. Retrieve current logged on Network UserName ' 2. Use Local ActiveDirectory to get information for this Username ' 3. Set MS Office UserName to ActiveDirectory "FullName"
' 4. Set MS Office UserAddress to YourCompanyNameGoesHere & vbNewLine & ActiveDirectory "Description"
' When MYDEBUG is TRUE
' MsgBox messages are displayed for verification
' All errors are ignored
' When MYDEBUG is FALSE
' MsgBox messages are not displayed for verification
' Errors are displayed
CONST MYDEBUG=TRUE
Dim objNetwork
Dim objWord
Dim objUser
Dim strNetworkUserName
Dim strFullName
Dim intLimitCount
Dim strDescription
Dim strCurrentName
Dim strCurrentAddress
'
' Get Network login username
'
intLimitCount=0
Set objNetwork=CreateObject("Wscript.Network")
strNetworkUserName=""
On Error Resume Next
Err.Clear
Do While LEN(strNetworkUserName)=0 AND intLimitCount<200 ' ~20 seconds
limit
intLimitCount=intLimitCount+1
strNetworkUserName=objNetwork.UserName
Err.Clear
If Wscript.Version > 5 Then
Wscript.Sleep 100
End If
Loop
If MYDEBUG then
On Error GoTo 0
End If
If LEN(strNetworkUserName)=0 then
If MYDEBUG then
Msgbox "Network login username not found",vbcritical
End If
Set objNetwork=Nothing
Stop
Else
If MYDEBUG then
MsgBox objNetwork.ComputerName & vbNewLine & _
objNetwork.UserDomain & vbNewLine & _
objNetwork.UserName
End If
End If
Set objNetwork=Nothing
Set objUser=GetObject("WinNT://" & "YourDomainGoesHere" & "/" & strNetworkUserName & ",user")
strFullName=objUser.Get("FullName")
strDescription=objUser.Get("Description")
' Start MS Word.
' Word should not already be running otherwise the ' Username & UserAddress sets below will not work.
Set objWord=CreateObject("Word.Application")
' Keep MS Word invisible
objWord.Visible=False
' Set MS Office Username field
strCurrentName=objWord.UserName
strCurrentAddress=objWord.UserAddress
' Is "IMAGE" in the current UserName?
If INSTR(1,UCASE(strCurrentName),"IMAGE")>0 then
If MYDEBUG then
Msgbox "Setting MS Office UserName to " & vbNewLine & _
vbTab & "'" & strFullName & "'" & vbNewLine & vbNewLine & _
"Length=" & LEN(strFullName)
End If
' Set the MS Office UserName
objWord.UserName=strFullName
End If
If LEN(strCurrentAddress)=0 then
If MYDEBUG then
Msgbox "Setting MS Office UserAddress to " & vbNewLine & _
"Your Company Name Goes Here" & vbNewLine & strDescription
End If
objWord.UserAddress="Your Company Name Goes Here" & vbNewLine & strDescription End if ' Shutdown MS Word
objWord.quit(False)
Set objWord=Nothing
' End
Rock Thought for the day:
I love the new song "No Phone" by Cake on their album, "Pressure Chief".