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".