This HTA dynamically retrieves user properties from AD and acts as a read-only AD user information console. The user lookup allows query wildcards and returns information for all matching users if the query returns multiple results.

If this script does not work due to formatting problems you can download the HTA directly.

<style>
td{
font-family:arial;
font-size:10pt;
color:black;
}
body{
font-family:arial;
font-size:10pt;
color:#000000;

}
.small{
font-family:arial;
font-size:8pt;
color:#000000;

}

</style>

</HEAD>
<SCRIPT language="VBScript">

Sub Click_Me
On Error Resume Next

userName = ServerNameBox.Value
strDomain = domainBox.Value

strDomain = Replace(strDomain,".",",dc=")

Set objRootDSE = GetObject("LDAP://RootDSE")
strCurrentDomain = objRootDSE.Get("DefaultNamingContext")

Set ADSysInfo = CreateObject("ADSystemInfo")
strCurrentUserObj = ADSysInfo.UserName

strCurrentUser = Replace(Left(strCurrentUserObj,InStr(strCurrentUserObj, "OU=") -2),"CN=","")

If UserName = "" Then
 UserName = strCurrentUser
End If

If strDomain = "" Then
 strDomain = strCurrentDomain
Else
strDomain = "dc=" & strDomain
End If

strDomainDisplay = Replace(strDomain,",DC=",".")
strDomainDisplay = Replace(strDomainDisplay,"DC=","")

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

strCommand = "SELECT SAMAccountName, scriptPath , memberOf, ProfilePath, PhysicalDeliveryOfficeName, lastLogon, scriptPath, userAccountControl, mail, msExchHomeServerName, HomeMDB, HomeDirectory, HomeDrive, Description, telephoneNumber, CN, DisplayName, Department, Title FROM `LDAP://" & strDomain & "` WHERE sAMaccountName=`" & userName & "` OR (CN=`" & userName & "`) OR (DisplayName=`" & userName & "`)"

objCommand.CommandText = strCommand
Set objRecordSet = objCommand.Execute

If NOT Err.Number = 0 Then
 MsgBox("Error performing lookup. Check your firewall is not blocking network access. Error Details: " & vbCRLF & strCommand & Err.Description)

Err.Number = 0
Else

strHTML = ""

objRecordSet.MoveFirst
Do Until objRecordSet.EOF

if(objRecordSet.Fields("userAccountControl").Value = 512) Then
accountLock = "Not Locked"
Else
accountLock = "Locked"
End If

strExch = objRecordSet.Fields("msExchHomeServerName").Value
If NOT strExch = "" Then
strExchServer = Right(strExch,Len(strExch) - InStrRev(strExch,"cn=")- 2)
End If

strExchMDB = objRecordSet.Fields("HomeMDB").Value
If NOT strExchMDB = "" Then
strExchSGDB = Replace(Left(strExchMDB, Instr(strExchMDB, ",CN=InformationStore")-1),"CN=","")
End If

colGroups = objRecordSet.Fields("memberOf")

strHTML = strHTML & "<h3>User Details</h3>" &_
"<b>Account Name: </b>" & objRecordSet.Fields("SAMAccountName").Value & "</br>" &_
"<b>AD Domain: </b>" & strDomainDisplay & "</br>" &_
"<b>Display Name: </b>" & objRecordSet.Fields("DisplayName").Value & "</br>" &_
"<b>CN Name: </b>" & objRecordSet.Fields("CN").Value & "</br>" &_ 
"<b>Description: </b>" & objRecordSet.Fields("Title").Value & "</br>" &_ 
"<b>Telephone: </b>" & objRecordSet.Fields("telephoneNumber").Value & "</br>" &_
"<b>Office: </b>" & objRecordSet.Fields("Department").Value &_
"<h3>Account Details</h3>" &_
"<b>Home Drive: </b>" & objRecordSet.Fields("HomeDrive").Value  & "</br>" &_
"<b>Home Directory: </b>" & objRecordSet.Fields("HomeDirectory").Value  & "</br>" &_
"<b>Profile Path: </b>" & objRecordSet.Fields("ProfilePath").Value  & "</br>" &_
"<b>Logon Script: </b>" & objRecordSet.Fields("scriptPath").Value  & "</br>" &_
"<b>Account Lockout: </b>" & accountLock   & "</br>" &_
"<b>Group Membership: </b><blockquote dir=`ltr` style=`MARGIN-RIGHT: 0px`>"

If isArray(colGroups) Then
For Each strGroup in colGroups

 strHTML = strHTML & "<span class=""small"">" & Replace(Replace(strGroup,strDomain, ""),"CN=","") & "</span></br>"
Next

End If

strHTML = strHTML &_
"</blockquote><h3>Exchange Details</h3>" &_
"<b>Exchange Server: </b>" & strExchServer  & "</br>" &_
"<b>Mail Store: </b>" & strExchSGDB  & "</br>" &_
"<b>Email Address: </b>" & objRecordSet.Fields("mail").Value & "</br></br><hr>"

    objRecordSet.MoveNext
Loop

Output.InnerHTML = strHTML

If NOT Err.Number = 0 Then
 MsgBox("User Not Found or Lookup Error: " & UserName & ". Error Details: " & Err.Description)
End If

End If

End Sub

</SCRIPT>
<BODY>
<b>Username: </b><input type=text name=ServerNameBox value="" size=15>
<b>AD Domain: </b><input type=text name=DomainBox value="" size=15>

<input id="runbutton" type="button" value="Lookup Info" name="run_button" onClick="Click_Me"> </br></br>
<span class="small">Instructions: Enter users logon ID, CN or display name and the full AD domain.
Leave either/both fields blank to default to the current user and domain. Use * as a wildcard within the username field after text only.</span>
</br><hr><span id="Output"></span>
</BODY>
</HTML>