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`WHERE SAMAccountName=`partialusername` OR and then the rest of the variables from the code
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>

Open in new window

osgisAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RobSampsonCommented:
Hi, try this as your SELECT string:
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 & "')"

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.
0
osgisAuthor Commented:
Still get an error on it, but this time the details after the SELECT are Table does not exist
0
RobSampsonCommented:
Try this:

<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," & _
      "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 & VbCrLf & 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>


I think you were speicifying "scriptPath" twice, and also the first Replace statement was missing a parameter, so if you had entered a domain, it would not have formatted correctly.  Your first replace statement was:
strDomain = Replace(strDomain,",dc=")

but should have been
strDomain = Replace(strDomain,".", ",dc=")

Regards,

Rob.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
osgisAuthor Commented:
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.
0
RobSampsonCommented:
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.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.