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 
 >    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 For
End 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 objProcess

Set oShell = CreateObject(“WScript.Shell”)
user       = oShell.ExpandEnvironmentStrings(“%UserName%”)
comp       = oShell.ExpandEnvironmentStrings(“%ComputerName%”)
userPath   = oShell.ExpandEnvironmentStrings(“%UserProfile%”)

Dim WshShellReg
Set WshShellReg = CreateObject(“WScript.Shell”)

Dim strPath1
Dim strPath2
Dim strPath3
Dim strPath4

strPath1 = “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
Next

If (uname <> “”) And (udomain <> “”) Then

Dim User
Dim domainname

domainname = udomain

Dim objRootDSE, strDomain, strUsername, objConnection, objCommand, objRecordSet, strDN
Const ADS_SCOPE_SUBTREE = 2

‘ Get domain components
Set objRootDSE = GetObject(“LDAP://RootDSE”)
strDomain = objRootDSE.Get(“DefaultNamingContext”)

‘ Get username to search for
‘strUsername = InputBox(“Please type a username to seach”)

‘ Set ADO connection
Set objConnection = CreateObject(“ADODB.Connection”)
objConnection.Provider = “ADsDSOObject”
objConnection.Open “Active Directory Provider”

‘ Set ADO command
Set objCommand = CreateObject(“ADODB.Command”)
Set objCommand.ActiveConnection = objConnection
objCommand.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 result
Set objRecordSet = objCommand.Execute

‘ If a user was found – Retrieve the distinguishedName
Dim strFullUserName
Dim strInitials
Dim strCompany

If 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 company
End If ‘ /test if recordset is empty
End If ‘ /detected username and domainname are not empty
Wscript.Quit

Function 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 = lngCount
End 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 If
Loop Until lngPos = 0

 StringGetInitials = strInitials
End 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, strDN
Const ADS_SCOPE_SUBTREE = 2

‘ Get domain components
Set objRootDSE = GetObject(LDAP://RootDSE)
strDomain = objRootDSE.Get(“DefaultNamingContext”)

‘ Get username to search for
strUsername = InputBox(“Please type a username to seach”)

‘ Set ADO connection
Set objConnection = CreateObject(“ADODB.Connection”)
objConnection.Provider = “ADsDSOObject”
objConnection.Open “Active Directory Provider”

‘ Set ADO command
Set objCommand = CreateObject(“ADODB.Command”)
Set objCommand.ActiveConnection = objConnection
objCommand.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 result
Set objRecordSet = objCommand.Execute

‘ If a user was found – Retrieve the distinguishedName
If 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 strDN
Else
MsgBox “No user found”
End If

 

Thank you for reading my article! Bye 🙂

Comments (1)

  1. Chris Allanson says:

    Hi, Nice article, the following does a very similar thing too thought I'd share it.

    const HKEY_CURRENT_USER = &H80000001

    strComputer = "."

    Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\" &_

    strComputer & "rootdefault:StdRegProv")

    Set objNetwork = WScript.CreateObject("WScript.Network")

    strUserName = objNetwork.UserName

    'connect to AD for info

    Dim objADSysInfo : Set objADSysInfo = CreateObject("ADSystemInfo")

    Dim objUser : Set objUser = GetObject("LDAP://" & objADSysInfo.UserName)

    strFNLN = objUser.FirstName & " "& objUser.LastName

    strInitials = Left(objUser.FirstName,1) & Left(objUser.LastName,1)

    'wscript.echo strInitials

    strKeyPath = "SoftwareMicrosoftOfficeCommonUserInfo"

    strValueName = "UserName"

    'oReg.GetExpandedStringValue HKEY_CURRENT_USER,strKeyPath,strValueName,strValue

    oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,strValueName,strFNLN

    'oReg.GetExpandedStringValue HKEY_CURRENT_USER,strKeyPath,strValueName,strValue

    strValueName = "UserInitials"

    oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,strValueName,strInitials

    strValueName = "Company"

    oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,strValueName,"Leeds City College"

    strKeyPath = "SoftwareMicrosoftOfficeCommon"

    strValueName = "Username"

    oReg.SetStringValue HKEY_CURRENT_USER,strKeyPath,strValueName,strUserName

    'WScript.Echo objUser.Mail & objUser.LastName & objUser.FirstName

    WScript.quit

Skip to main content