Need some editing in this Hta script.
Hi,
I got this script from the Net.
This when entered a name gets lots of info about the user.
I need to add some more things.
Description
Mobile No
Managername
Company
Title
Ext No
Notes
Regards
Sharath
I got this script from the Net.
This when entered a name gets lots of info about the user.
I need to add some more things.
Description
Mobile No
Managername
Company
Title
Ext No
Notes
Regards
Sharath
<HTML>
<HEAD>
<TITLE>AD User Lookup</TITLE>
<HTA:Application
ApplicationName = AD User Lookup
BorderStyle = Raised
ShowInTaskBar = Yes
MaximizeButton = Yes
MinimizeButton = Yes
WindowState = Normal
SingleInstance = Yes
>
<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 = UserNameBox.Value
strDomain = domainBox.Value
strDomain = Replace(strDomain,".",",dc=")
Set objRootDSE = GetObject("LDAP://RootDSE")
strCurrentDomain = objRootDSE.Get("DefaultNamingContext")
strCurrentDomain = Replace(strCurrentDomain,",DC=",".")
strCurrentDomain = Replace(strCurrentDomain,"DC=","")
Set ADSysInfo = CreateObject("ADSystemInfo")
strCurrentUserObj = ADSysInfo.UserName
strCurrentUser = Replace(Left(strCurrentUserObj,InStr(strCurrentUserObj, "OU=") -2),"CN=","")
If UserName = "" Then
UserName = strCurrentUser
UserNameBox.Value = userName
End If
If strDomain = "" Then
strDomain = strCurrentDomain
domainBox.Value = strDomain
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("Cannot performing lookup. Check your firewall is not blocking network access. " & vbCRLF & vbCRLF & "Error Details: " & vbCRLF & strCommand & Err.Description)
Err.Number = 0
Else
strHTML = "<table>"
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 & "<tr valign='top'><td width='50%'>"
strHTML = strHTML & "<h2>" & objRecordSet.Fields("DisplayName").Value & "</h2> <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>Designation: </b>" & objRecordSet.Fields("Title").Value & "</br>" &_
"<b>Telephone: </b>" & objRecordSet.Fields("telephoneNumber").Value & "</br>" &_
"<b>Office: </b>" & objRecordSet.Fields("Department").Value
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/>"
strHTML = strHTML & "</td><td width='50%'><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 & "<br/><br/>"
strHTML = strHTML & "</td></tr> <tr bgcolor='black'><td></td><td></td></tr> "
objRecordSet.MoveNext
Loop
strHTML = strHTML & "</table>"
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=UserNameBox value="" size=20>
<b>AD Domain: </b><input type=text name=DomainBox value="" size=30>
<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>
<br/><br/>
</BODY>
</HTML>
ASKER
The hta file gets lots of data regaring the user.I need to add some more data.
Description
Mobile No
Managername
Company
Title
Ext No
Notes
Description
Mobile No
Managername
Company
Title
Ext No
Notes
What do you mean by extension and Notes and what are the properties in AD for this?
regards
Chandru
regards
Chandru
Try this version.............
regards
Chandru
regards
Chandru
<HTML>
<HEAD>
<TITLE>AD User Lookup</TITLE>
<HTA:Application
ApplicationName = AD User Lookup
BorderStyle = Raised
ShowInTaskBar = Yes
MaximizeButton = Yes
MinimizeButton = Yes
WindowState = Normal
SingleInstance = Yes
>
<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 = UserNameBox.Value
strDomain = domainBox.Value
strDomain = Replace(strDomain,".",",dc=")
Set objRootDSE = GetObject("LDAP://RootDSE")
strCurrentDomain = objRootDSE.Get("DefaultNamingContext")
strCurrentDomain = Replace(strCurrentDomain,",DC=",".")
strCurrentDomain = Replace(strCurrentDomain,"DC=","")
Set ADSysInfo = CreateObject("ADSystemInfo")
strCurrentUserObj = ADSysInfo.UserName
strCurrentUser = Replace(Left(strCurrentUserObj,InStr(strCurrentUserObj, "OU=") -2),"CN=","")
If UserName = "" Then
UserName = strCurrentUser
UserNameBox.Value = userName
End If
If strDomain = "" Then
strDomain = strCurrentDomain
domainBox.Value = strDomain
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, mobile, manager, company 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("Cannot performing lookup. Check your firewall is not blocking network access. " & vbCRLF & vbCRLF & "Error Details: " & vbCRLF & strCommand & Err.Description)
Err.Number = 0
Else
strHTML = "<table>"
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 & "<tr valign='top'><td width='50%'>"
strHTML = strHTML & "<h2>" & objRecordSet.Fields("DisplayName").Value & "</h2> <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>Designation: </b>" & objRecordSet.Fields("Title").Value & "</br>" &_
"<b>Telephone: </b>" & objRecordSet.Fields("telephoneNumber").Value & "</br>" &_
"<b>Office: </b>" & objRecordSet.Fields("physicalDeliveryOfficeName").Value & "</br>" &_
"<b>Mobile: </b>" & objRecordSet.Fields("mobile").Value & "</br>" &_
"<b>Manager: </b>" & objRecordSet.Fields("manager").Value & "</br>" &_
"<b>Company: </b>" & objRecordSet.Fields("company").Value & "</br>" &_
"<b>Title: </b>" & objRecordSet.Fields("title").Value
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/>"
strHTML = strHTML & "</td><td width='50%'><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 & "<br/><br/>"
strHTML = strHTML & "</td></tr> <tr bgcolor='black'><td></td><td></td></tr> "
objRecordSet.MoveNext
Loop
strHTML = strHTML & "</table>"
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=UserNameBox value="" size=20>
<b>AD Domain: </b><input type=text name=DomainBox value="" size=30>
<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>
<br/><br/>
</BODY>
</HTML>
Did you check this HTA where i have added the infomration required below the user details?
regards
Chandru
regards
Chandru
ASKER
Chandru the Title which is below the Company has to fetch the managers title as above we have the users title already.
Even have the notes tab details to the HTA file.
In the notes box i have the users machine there.
If you can add any other details to the HTa please do it...
Even have the notes tab details to the HTA file.
In the notes box i have the users machine there.
If you can add any other details to the HTa please do it...
Managers titile cannot be fetched as we are queryiing the users details
I can add the notes details for you
regards
Chandru
I can add the notes details for you
regards
Chandru
what is the attribute for notes? where do you put this information in AD
ASKER
In the users properties you have notes in > Telephones Tab
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks a lot Chandru
Thanks Sharath!
- adding the fields
- extracting them from the recordset
- something else