VB Script - Get the Full Domain User name for a process (Wscript + Active Dir. LDAP) and set the Office User Info
This blog post is going to follow-up on my previous article (https://blogs.msdn.com/b/cristib/archive/2010/12/16/vba-how-to-get-the-account-login-user-name-and-the-account-full-name-for-a-program-ex-microsoft-word.aspx), where I wrote about how to retrieve information about a local user account's profile.
In the aforementioned link I used the WinNT provider:
https://msdn.microsoft.com/en-us/library/windows/desktop/aa746543(v=VS.85).aspx WinNT User Object ------------------------------------------------------------------- The WinNT User object represents a user account in a Windows NT 4.0 domain. The object exhibits special features. In one instance, it does not support all the property methods of the IADsUser interface. In a second instance, it supports some custom properties that can be accessed only with the IADs.Get or IADs.Put method. |
https://msdn.microsoft.com/en-us/library/windows/desktop/aa746534(v=vs.85).aspx WinNT ADsPath ------------------------------------------------------------------- The ADsPath string for the ADSI WinNT provider can be one of the following forms: WinNT: WinNT://<domain name> WinNT://<domain name>/<server> WinNT://<domain name>/<path> WinNT://<domain name>/<object name> WinNT://<domain name>/<object name>,<object class> WinNT://<server> WinNT://<server>/<object name> WinNT://<server>/<object name>,<object class> The domain name can be either a NETBIOS name or a DNS name. The server is the name of a specific server within the domain. The path is the path of on object, such as "printserver1/printer2". The object name is the name of a specific object. The object class is the class name of the named object. One example of this usage would be "WinNT://MyServer/JeffSmith,user". Specifying a class name can improve the performance of the bind operation. |
https://msdn.microsoft.com/en-us/library/windows/desktop/aa746535(v=VS.85).aspx WinNT Custom User Properties ------------------------------------------------------------------- The WinNT provider makes available the following custom properties for the User class. They may be accessed through the IADs.Get and IADs.Put methods. For more information, see the USER_INFO_3 structure. |
... which, as you can read from these links, is a very old tool developed for an WinNT domain architecture.
Since the WinNT provider only supports features available in Windows NT domains, what do we use for accessing newer properties not available in the USER_INFO_3 structure? The answer is: LDAP (Lightweight Directory Access Protocol) .
https://msdn.microsoft.com/en-us/library/windows/desktop/aa746445(v=VS.85).aspx Provider Support of ADSI Interfaces ------------------------------------------------------------------- ... ... ... ... ...... ... ... ...... ...... ...... ... Provider Support for IADsUser
|
The LDAP provider is faster and more efficient. WinNT will not detect the hierarchy of an Active Directory configuration (ex: it can't recognize Organizational Units).
More information on LDAP:
> ADSI Objects of LDAP> IADsUser interface
> LDAP ADsPath
In the following sample code I am going to show you how to detect the Active Directory User Name and Company detail and how to extract the user's Initials from the User Name field. We will use them to fill in the Office
First of all, we have to gather all the parameters needed by the LDAP query. So we start with the logged-on user name ... we can get it with Windows API (https://support.microsoft.com/kb/161394) or we can simply enumerate all the running processes and find the Console script or Windows script engine, depending on how this code is executed (from a CMD prompt console, or by Windows Explorer double-click).
Dim computer computer = "."Dim objWMIService, colProcessList Set objWMIService = GetObject("winmgmts:\\" & computer & "\root\cimv2")Set colProcessList = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'WSCRIPT.EXE' OR Name = 'CSCRIPT.EXE'")Dim uname, udomain Dim objProcess ... ... 'reset the user name / domain data uname = ""udomain = "" For Each objProcess In colProcessList 'check whether the 'cscript' process is actually running our code. 'If YES then we can retrieve the user name and domain details; If Instr(1,objProcess.CommandLine,WScript.ScriptName) > 0 Then objProcess.GetOwner uname, udomain Exit ForEnd If Next ... .... |
After we get the logged on user name and domain, we execute the query like this:
objCommand.CommandText = "SELECT distinguishedName,company FROM 'LDAP://" & domainname & "' WHERE objectCategory='user' AND samAccountName = '" & uname & "'" ' Set recordset to hold the query result Set objRecordSet = objCommand.Execute |
... and we get as return (if the command is successful) a RecordSet object.
Please note that we asked for the DISTINGUISHEDNAME field, not the NAME entry (but they are identical). The DistinguishedName is a sequence of attributes very important for an user account:
https://msdn.microsoft.com/en-us/library/windows/desktop/aa366101(v=vs.85).aspx Distinguished Names ------------------------------------------------------------------- The LDAP API references an LDAP object by its distinguished name (DN). A DN is a sequence of relative distinguished names (RDN) connected by commas. An RDN is an attribute with an associated value in the form attribute=value; normally expressed in a UTF-8 string format. The following table lists typical RDN attribute types. String Attribute type DC domainComponent CN commonName OU organizationalUnitName O organizationName STREET streetAddress L localityName ST stateOrProvinceName C countryName UID userid |
I could have retrieved other fields such as:
> CN - Common Name
> description
> displayName
> homeDrive
> name (the same as CN)
> objectCategory
> objectClass
> physicalDeliveryOfficeName
> profilePath
> sAMAccountName
> SN (last name or surname)
> userAccountControl
> homeMDB (MailStore)
> mail
> c (country or region)
> company (company or organization name)
> department
> homephone
> location (important, particularly for printers)
> manager
> mobile
> ObjectClass (user or computer)
> OU
> postalCode
> st (state, province / county)
> streetAddress
> telephoneNumber
After all the details are ready (notice the routine that gets the initials out of the DistinguishedName), all that remains is to write them into the registry keys:
"HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserName"
"HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserInitials"
"HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\Company"
"HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\CompanyName
Here is the full code listing:
============================================================== ' * Please note that Microsoft provides programming examples ' * for illustration only, without warranty either expressed or implied, ' * including, but not limited to, the implied warranties of merchantability ' * and/or fitness for a particular purpose. Any use by you of the code provided ' * in this blog is at your own risk. '===============================================================
Dim computer computer = "."Dim objWMIService, colProcessList Set objWMIService = GetObject("winmgmts:\\" & computer & "\root\cimv2")Set colProcessList = objWMIService.ExecQuery("SELECT * FROM Win32_Process WHERE Name = 'WSCRIPT.EXE' OR Name = 'CSCRIPT.EXE'")Dim uname, udomain Dim objProcessSet oShell = CreateObject("WScript.Shell")user = oShell.ExpandEnvironmentStrings("%UserName%")comp = oShell.ExpandEnvironmentStrings("%ComputerName%")userPath = oShell.ExpandEnvironmentStrings("%UserProfile%")Dim WshShellRegSet WshShellReg = CreateObject("WScript.Shell")Dim strPath1 Dim strPath2 Dim strPath3 Dim strPath4strPath1 = "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserName" strPath2 = "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\UserInitials" strPath3 = "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\Company" strPath4 = "HKEY_CURRENT_USER\Software\Microsoft\Office\Common\UserInfo\CompanyName"'reset the user name / domain data uname = ""udomain = "" For Each objProcess In colProcessList'check whether the 'cscript' process is actually running our code. If YES 'then we can retrieve the user name and domain details; If Instr(1,objProcess.CommandLine,WScript.ScriptName) > 0 Then objProcess.GetOwner uname, udomain Exit For End If NextIf (uname <> "") And (udomain <> "") ThenDim User Dim domainname domainname = udomainDim objRootDSE, strDomain, strUsername, objConnection, objCommand, objRecordSet, strDNConst ADS_SCOPE_SUBTREE = 2' Get domain componentsSet objRootDSE = GetObject("LDAP://RootDSE")strDomain = objRootDSE.Get("DefaultNamingContext")' Get username to search for'strUsername = InputBox("Please type a username to seach")' Set ADO connectionSet objConnection = CreateObject("ADODB.Connection")objConnection.Provider = "ADsDSOObject"objConnection.Open "Active Directory Provider"' Set ADO commandSet objCommand = CreateObject("ADODB.Command")Set objCommand.ActiveConnection = objConnectionobjCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE objCommand.CommandText = "SELECT distinguishedName,company FROM 'LDAP://" & domainname & "' WHERE objectCategory='user' AND samAccountName = '" & uname & "'"' Set recordset to hold the query resultSet objRecordSet = objCommand.Execute' If a user was found - Retrieve the distinguishedNameDim strFullUserNameDim strInitialsDim strCompanyIf Not objRecordSet.EOF Then ' retrieve the Active Directory 'User Name' detail strFullUserName = objRecordSet.Fields("distinguishedName").Value ' retrieve the Active Directory 'Company' detail strCompany = objRecordSet.Fields("company").Value If Err.Number <> 0 Then MsgBox "Domain or User does not exist." Wscript.Quit End If ' set full name Dim strTmpUserN If strFullUserName = "" Then WshShellReg.RegWrite strPath1, "N/A" , "REG_SZ" Else strTmpUserN = StringGetUserName(strFullUserName) WshShellReg.RegWrite strPath1, strTmpUserN, "REG_SZ" End If ' set initials If strFullUserName = "" Then WshShellReg.RegWrite strPath2, "" , "REG_SZ" Else WshShellReg.RegWrite strPath2, stringGetInitials(strTmpUserN), "REG_SZ" End If ' /set initials ' set Company If strCompany = "" Then WshShellReg.RegWrite strPath3, "" , "REG_SZ" WshShellReg.RegWrite strPath4, "" , "REG_SZ" Else WshShellReg.RegWrite strPath3, strCompany, "REG_SZ" WshShellReg.RegWrite strPath4, strCompany, "REG_SZ" End If ' /set companyEnd If ' /test if recordset is emptyEnd If ' /detected username and domainname are not emptyWscript.QuitFunction StringCountOccurrences(strText, strFind) Dim lngPos Dim lngTemp Dim lngCount If Len(strText) = 0 Then Exit Function If Len(strFind) = 0 Then Exit Function lngPos = 1 Do lngPos = InStr(lngPos, strText, strFind) lngTemp = lngPos If lngPos > 0 Then lngCount = lngCount + 1 lngPos = lngPos + Len(strFind) End If Loop Until lngPos = 0 StringCountOccurrences = lngCountEnd Function Function StringGetInitials(strText) Dim strFind Dim lngPos Dim lngTemp Dim lngCount Dim strInitials strFind = " " If Len(strText) = 0 Then Exit Function If Len(strFind) = 0 Then Exit Function If StringCountOccurrences(strText, " ") = Len(strText) Then Exit Function If lngPos > 0 Then lngPos = lngPos + Len(strFind) End If End IfLoop Until lngPos = 0 StringGetInitials = strInitialsEnd Function |
Also, please find below a code sample which retrieves the FullName, Company, MailBox detail, and Manager fiels for an user account selected at runtime.
Option Explicit Dim objRootDSE, strDomain, strUsername, objConnection, objCommand, objRecordSet, strDNConst ADS_SCOPE_SUBTREE = 2 ' Get domain componentsSet objRootDSE = GetObject("LDAP://RootDSE")strDomain = objRootDSE.Get("DefaultNamingContext") ' Get username to search forstrUsername = InputBox("Please type a username to seach") ' Set ADO connectionSet objConnection = CreateObject("ADODB.Connection")objConnection.Provider = "ADsDSOObject"objConnection.Open "Active Directory Provider" ' Set ADO commandSet objCommand = CreateObject("ADODB.Command")Set objCommand.ActiveConnection = objConnectionobjCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE objCommand.CommandText = "SELECT distinguishedName,company,name,homeMDB,manager FROM 'LDAP://" & strDomain & "' WHERE objectCategory='user' AND samAccountName = '" & strUsername & "'" ' Set recordset to hold the query resultSet objRecordSet = objCommand.Execute ' If a user was found - Retrieve the distinguishedNameIf Not objRecordSet.EOF Then strDN = objRecordSet.Fields("distinguishedName").Value strDN = strDN & " - " & vbNewline strDN = strDN & vbNewline & objRecordSet.Fields("company").Value strDN = strDN & vbNewline & objRecordSet.Fields("name").Value strDN = strDN & vbNewline & objRecordSet.Fields("homeMDB").Value strDN = strDN & vbNewline & objRecordSet.Fields("manager").Value MsgBox strDNElseMsgBox "No user found"End If |
Thank you for reading my article! Bye :-)