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 (http://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

http://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.

 

http://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.

 

http://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) .

http://msdn.microsoft.com/en-us/library/windows/desktop/aa746445(v=VS.85).aspx

 Provider Support of ADSI Interfaces -------------------------------------------------------------------

... ... ... ... ...... ...

... ...... ...... ...... ...

Provider Support for IADsUser

Property LDAP WinNT
AccountDisabled Supported Supported
AccountExpirationDate Supported Supported
BadLoginAddress Unsupported Not supported
BadLoginCount Supported Supported
Department Supported Unsupported
Description Supported Supported
Division Supported Unsupported
EmailAddress Supported Unsupported
EmployeeID Supported Unsupported
FaxNumber Supported Unsupported
FirstName Supported Unsupported
FullName Supported Supported
GraceLoginsAllowed Not Supported Unsupported
GraceLoginsRemaining Not Supported Unsupported
HomeDirectory Supported Supported
HomePage Supported Unsupported
IsAccountLocked Supported Supported
Languages Not Supported Unsupported
LastFailedLogin Supported Unsupported
LastLogin Supported Supported
LastLogoff Supported Supported
LastName Supported Unsupported
LoginHours Supported Supported
LoginScript Supported Supported
LoginWorkstations Supported Supported
Manager Supported Unsupported
MaxLogins Unsupported Unsupported
MaxStorage Supported Supported
NamePrefix Supported Unsupported
NameSuffix Supported Unsupported
OfficeLocations Supported Unsupported
OtherName Supported Unsupported
PasswordExpirationDate Unsupported Supported
PasswordLastChanged Supported Unsupported
PasswordMinimumLength Unsupported Supported
PasswordRequired Supported Supported
Picture Supported Unsupported
PostalAddresses Supported Unsupported
PostalCodes Supported Unsupported
Profile Supported Supported
RequireUniquePassword Unsupported Unsupported
SeeAlso Supported Unsupported
TelephoneHome Supported Unsupported
TelephoneMobile Supported Unsupported
TelephoneNumber Supported Unsupported
TelephonePager Supported Unsupported
Title Supported Unsupported

  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 (http://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:

http://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 :-)