Function UserName() Dim objWMI, colComputers, objComputer, strUser, ws, env On Error Resume Next strUser = "" Err.Clear Set objWMI = GetObject("winmgmts:\\.\root\CIMV2") Set colComputers = objWMI.ExecQuery("SELECT * FROM Win32_ComputerSystem", "WQL", 48) If Err.Number <> 0 Then 'WMI Failure. Try environment Set ws = CreateObject("Wscript.Shell") Set env = ws.Environment("Process") strUser = env.Item("USERNAME") Else For Each objComputer In colComputers strUser = objComputer.UserName Next If Instr(strUser, "\") Then strUser = Mid(strUser, Instr(strUser, "\") + 1) End If End If Set objWMI = Nothing UserName = strUser End Function