Updating the Officer Username
This one has bugged me for a long time but ive finally stolen someone elses code :) Sorry I cannot give credit as I have no idea who made it.
This is useful under the following scenario:
Staff use spreadsheets as 'databases'
Staff1 opens excel.xls
Staff2 opens excel.xls and cannot edit because Staff1 has locked it.
Staff2 gets the message cannot open excel.xls for writing because 'Administrator' has the file open ('Administrator' is used because the default profile is set when the workstation image is made)
Staff2 whinges to techs because they want to edit.
By using this code as a login script it will update staff members username in tools->options->general->User Name (and initials) to their current username. This will give them the error: cannot open excel.xls because 'Staff1' has the file open. Staff2 promptly whinges to Staff1. YAY! Less whinging.
The only thing you will have to change is the strOfficePath to your relevant version, Office 2003 is 11.0 which is what I have used.
Set nw = CreateObject("WScript.Network")
Const HKEY_CURRENT_USER = &H80000001
strOfficePath = "Software\Microsoft\Office\11.0\Common\UserInfo"
strMachineName = "."
strUserName = nw.UserName
max = len(strUserName)
For intLoop = 1 to max step 1
asciiName = asc(mid(strUserName, intLoop, 1))
if newAsciiName = "" and newAsciiInitials = "" Then
newAsciiName = asciiName
'newAsciiInitials = asciiName
newAsciiName = newAsciiName & "," & "00" & "," & asciiName
If intLoop <= 2 then
newAsciiInitials = newAsciiName & "," & "00"
updateName = Split(newAsciiName,",")
updateInitials = Split(newAsciiInitials,",")
strMoniker = "winMgmts:\\" & strMachineName & "\root\default:StdRegProv"
Set oReg = GetObject(strMoniker)
userNameSet = oReg.SetBinaryValue(HKEY_CURRENT_USER, strOfficePath, "UserName", updateName)
userInitialsSet = oReg.SetBinaryValue(HKEY_CURRENT_USER, strOfficePath, "UserInitials", updateInitials)