OSG USA
asked on
HTA using VBScript Errors
We are attempting to come up with solution that will allow anyone to quickly look up a phone number for users in our org through LDAP to AD. I found this code on the 'Net and from my basic knowledge looks functional, however when it's run no matter what is put in I get an error box stating:
The error text in the code with the details as:
SELECT SAMAccountName, and all other calls FROM `LDAP://dc=ourdomainname`W
One or more errors occurred during processing of command.
I attempted to change the ` to ' and the error still comes up but with table doesn't exist.
I am not developer or scripter so I am not sure where to tackle this, or if there is an easier way to do this. I can hack together some VBscript to get AD to dump the phone numbers to a spreadsheet, but we want an on demand lookup tool/web page.
The error text in the code with the details as:
SELECT SAMAccountName, and all other calls FROM `LDAP://dc=ourdomainname`W
One or more errors occurred during processing of command.
I attempted to change the ` to ' and the error still comes up but with table doesn't exist.
I am not developer or scripter so I am not sure where to tackle this, or if there is an easier way to do this. I can hack together some VBscript to get AD to dump the phone numbers to a spreadsheet, but we want an on demand lookup tool/web page.
<HTML>
<HEAD>
<TITLE>User Lookup</TITLE>
<HTA:Application
ApplicationName = HTADemo
BorderStyle = Raised
ShowInTaskBar = No
MaximizeButton = Yes
MinimizeButton = Yes
WindowState = Normal
>
<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>
ASKER
Still get an error on it, but this time the details after the SELECT are Table does not exist
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 Rob, I would have never figured that out. I can hack together most of the scripts that I need but was totally out of my element here.
No problem. A HTA doesn't really add that much more complexity, but for one thing, I always remove any On Error Resume Next statements when trouble-shooting, so that you get told exactly where the error is. There was actually an initial error with that first Replace statement, meaning that err.Number was already not zero by the time it got down to the SELECT query, so even if the query executed properly, you'd still get an error condition in your check.
Thanks for the grade.
Regards,
Rob.
Thanks for the grade.
Regards,
Rob.
strCommand = "SELECT SAMAccountName,scriptPath,
"ProfilePath,PhysicalDeliv
"scriptPath,userAccountCon
"HomeMDB,HomeDirectory,Hom
"CN,DisplayName,Department
"FROM 'LDAP://" & strDomain & "' " & _
"WHERE sAMaccountName='" & userName & "' OR (CN='" & userName & "') OR (DisplayName='" & userName & "')"
It looked mostly fine except for perhaps the spaces around the commas (not sure if it likes those), and the single quote characters looked like ones you get when pasted from the Net. Make sure those a normal single quote characters.
Regards,
Rob.