Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

AD Server script that stopped working after months of using it.

Status
Not open for further replies.
shdwmyst

shdwmyst

IS-IT--Management
Aug 26, 2011
4
US
Hello,

I have a script that came together from joint efforts of people and using some code I found on the web to Frankenstein the script. After months of using it, it no longer runs due to an error. It looks like an obvious error but I am not sure how to go about verifying or fixing it. I am not a strong or even intermediate VBS programmer. Any help would be greatly appreciated!


Error:

Line: 86
Char: 1
Error: Table Does Not Exist
Code: 80040E37
Source: Provider



Code:

Option Explicit

Dim adoCommand, adoConnection, strBase, strFilter, strFilter2, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset, strName, strDN,
strBaseOU
Dim strExcelpath, strExcelpath2, objExcel, objSheet, intRow, intCol, objUser
Dim arrbytSIDs, objGroupList, j, arrstrGroupSIDs(), objGroup
Dim strGroupName
Dim oShell, oEnv, oFS, strDirectory, strIncrement, numIncrement


'Create the folder to place the reports.
Set oShell = CreateObject("wscript.Shell")
set oFS = CreateObject("scripting.FileSystemObject")
Set oEnv = oShell.Environment("Process")
strDirectory = oEnv("USERPROFILE") & "\Desktop\Audit Reports"
if not oFS.FolderExists(strDirectory) then oFS.CreateFolder(strDirectory &
strIncrement)
'--- this is new
strDirectory=strDirectory & "\" & "XX " & Month(Now) & "-" & Day(Now) &
"-" & Year(Now)
strIncrement = ""
numIncrement = 0
Do While True
if not oFS.FolderExists(strDirectory & strIncrement) then
oFS.CreateFolder(strDirectory & strIncrement)
strDirectory=strDirectory & strIncrement
Exit Do
Else
numIncrement=numIncrement+1
strIncrement="_" & CStr(numIncrement)
End If
Loop
' Spreadsheet file name to be created.
strExcelPath = strDirectory & "\XX-Active.xls"
strExcelPath2 = strDirectory & "\XX-Disabled.xls"

' Bind to Excel.
Set objExcel = CreateObject("Excel.Application")

' Create new workbook.
objExcel.Workbooks.Add

' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Domain Users"

' Write column headings.
objSheet.Cells(1, 1).Value = "sAMAccountName"
objSheet.Cells(1, 2).value = "Distinguished Name"
objSheet.Cells(1, 3).Value = "Group Memberships"

' Dictionary object to keep track of group SID values.
Set objGroupList = CreateObject("Scripting.Dictionary")
objGroupList.CompareMode = vbTextCompare

' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

' Edit the next line to reflect your OU
strBaseOU ="OU=XX,OU=Accounts"

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase ="<LDAP://" & strBaseOU & "," & strDNSDomain & ">"

strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(!userAccountControl:1.2.840.113556.1.4.803:=2))"
strFilter2 = "(&(objectCategory=person)(objectClass=user)" _
& "(userAccountControl:1.2.840.113556.1.4.803:=2))"

' Comma delimited list of attribute values to retrieve.
' Cannot retrieve tokenGroups with ADO.
strAttributes = "sAMAccountName,distinguishedName"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute ' Line 76

' Enumerate the resulting recordset.
intRow = 2
Do Until adoRecordset.EOF
' Retrieve values and display.
strName = adoRecordset.Fields("sAMAccountName").Value
objSheet.Cells(intRow, 1).Value = strName
strDN = adoRecordset.Fields("distinguishedName").value
strDN = Replace(strDN, "/", "\/")
objSheet.Cells(intRow, 2).Value = Mid(Split(strDN,",")(0),4)
' Bind to the user object.
Set objUser = GetObject("LDAP://" & strDN)
' Retrieve tokenGroups attribute.
objUser.GetInfoEx Array("tokenGroups"), 0
arrbytSIDs = objUser.Get("tokenGroups")
If (UBound(arrbytSIDs) = -1) Then
' No group SID values, do nothing.
ElseIf (TypeName(arrbytSIDs) = "Byte()") Then
' One group SID.
ReDim arrstrGroupSIDs(0)
arrstrGroupSIDs(0) = OctetToHexStr(arrbytSIDs)
' Check if this group encountered before.
If (objGroupList.Exists(arrstrGroupSIDs(0)) = False) Then
' Save group SID and name in dictionary object.
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSIDs(0) &
">")
strGroupName = objGroup.distinguishedName
objGroupList.Add arrstrGroupSIDs, strGroupName
'objSheet.Cells(intRow, 3).Value = strGroupName
objSheet.Cells(intRow, 3).Value =
Mid(Split(strGroupName,",")(0),4) & Chr(10) &
objSheet.Cells(intRow, 3).Value
Else

' Retrieve group name from dictionary object.
strGroupName = objGroupList(arrstrGroupSIDs(0))
'objSheet.Cells(intRow, 3).Value = strGroupName
objSheet.Cells(intRow, 3).Value =
Mid(Split(strGroupName,",")(0),4) & Chr(10) &
objSheet.Cells(intRow, 3).Value
End If
Else

' More than one SID value in the array.
intCol = 3
ReDim arrstrGroupSIDs(UBound(arrbytSIDs))
For j = 0 To UBound(arrbytSIDs)
arrstrGroupSIDs(j) = OctetToHexStr(arrbytSIDs(j))
' Check if this group encountered before.
If (objGroupList.Exists(arrstrGroupSIDs(j)) = False) Then
' Save group SID and name in dictionary object.
Set objGroup = GetObject("LDAP://<SID=" &
arrstrGroupSIDs(j) & ">")
strGroupName = objGroup.distinguishedName
objGroupList.Add arrstrGroupSIDs(j), strGroupName
'objSheet.Cells(intRow, intCol).Value = strGroupName
objSheet.Cells(intRow, 3).Value =
Mid(Split(strGroupName,",")(0),4) & Chr(10) &
objSheet.Cells(intRow, 3).Value
Else
' Retrieve group name from dictionary object.
strGroupName = objGroupList(arrstrGroupSIDs(j))
'objSheet.Cells(intRow, 3).Value = strGroupName
objSheet.Cells(intRow, 3).Value =
Mid(Split(strGroupName,",")(0),4) & Chr(10) &
objSheet.Cells(intRow, 3).Value
End If
Next
End If
' Move to the next record in the recordset.
intRow = intRow + 1
adoRecordset.MoveNext
Loop



' Save spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

' Quit Excel and clean up.
objExcel.Application.Quit
objExcel.Application.Quit
'adoRecordset.Close
'adoConnection.Close

' Bind to Excel.
Set objExcel = CreateObject("Excel.Application")

' Create new workbook.
objExcel.Workbooks.Add

' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Domain Users"

' Write column headings.
objSheet.Cells(1, 1).Value = "sAMAccountName"
objSheet.Cells(1, 2).value = "Distinguished Name"
objSheet.Cells(1, 3).Value = "Group Memberships"

' Dictionary object to keep track of group SID values.
Set objGroupList = CreateObject("Scripting.Dictionary")
objGroupList.CompareMode = vbTextCompare

' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

' Edit the next line to reflect your OU
strBaseOU ="OU=DE,OU=Accounts"

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase ="<LDAP://" & strBaseOU & "," & strDNSDomain & ">"


' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter2 & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute


' Enumerate the resulting recordset for disabled accounts.
intRow = 2
Do Until adoRecordset.EOF
' Retrieve values and display.
strName = adoRecordset.Fields("sAMAccountName").Value
objSheet.Cells(intRow, 1).Value = strName
strDN = adoRecordset.Fields("distinguishedName").value
strDN = Replace(strDN, "/", "\/")
objSheet.Cells(intRow, 2).Value = Mid(Split(strDN,",")(0),4)
' Bind to the user object.
Set objUser = GetObject("LDAP://" & strDN)
' Retrieve tokenGroups attribute.
objUser.GetInfoEx Array("tokenGroups"), 0
arrbytSIDs = objUser.Get("tokenGroups")
If (UBound(arrbytSIDs) = -1) Then
' No group SID values, do nothing.
ElseIf (TypeName(arrbytSIDs) = "Byte()") Then
' One group SID.
ReDim arrstrGroupSIDs(0)
arrstrGroupSIDs(0) = OctetToHexStr(arrbytSIDs)
' Check if this group encountered before.
If (objGroupList.Exists(arrstrGroupSIDs(0)) = False) Then
' Save group SID and name in dictionary object.
Set objGroup = GetObject("LDAP://<SID=" & arrstrGroupSIDs(0) &
">")
strGroupName = objGroup.distinguishedName
objGroupList.Add arrstrGroupSIDs, strGroupName
'objSheet.Cells(intRow, 3).Value = strGroupName
objSheet.Cells(intRow, 3).Value =
Mid(Split(strGroupName,",")(0),4) & Chr(10) &
objSheet.Cells(intRow, 3).Value
Else

' Retrieve group name from dictionary object.
strGroupName = objGroupList(arrstrGroupSIDs(0))
'objSheet.Cells(intRow, 3).Value = strGroupName
objSheet.Cells(intRow, 3).Value =
Mid(Split(strGroupName,",")(0),4) & Chr(10) &
objSheet.Cells(intRow, 3).Value
End If
Else

' More than one SID value in the array.
intCol = 3
ReDim arrstrGroupSIDs(UBound(arrbytSIDs))
For j = 0 To UBound(arrbytSIDs)
arrstrGroupSIDs(j) = OctetToHexStr(arrbytSIDs(j))
' Check if this group encountered before.
If (objGroupList.Exists(arrstrGroupSIDs(j)) = False) Then
' Save group SID and name in dictionary object.
Set objGroup = GetObject("LDAP://<SID=" &
arrstrGroupSIDs(j) & ">")
strGroupName = objGroup.distinguishedName
objGroupList.Add arrstrGroupSIDs(j), strGroupName
'objSheet.Cells(intRow, intCol).Value = strGroupName
objSheet.Cells(intRow, 3).Value =
Mid(Split(strGroupName,",")(0),4) & Chr(10) &
objSheet.Cells(intRow, 3).Value
Else
' Retrieve group name from dictionary object.
strGroupName = objGroupList(arrstrGroupSIDs(j))
'objSheet.Cells(intRow, 3).Value = strGroupName
objSheet.Cells(intRow, 3).Value =
Mid(Split(strGroupName,",")(0),4) & Chr(10) &
objSheet.Cells(intRow, 3).Value
End If
Next
End If
' Move to the next record in the recordset.
intRow = intRow + 1
adoRecordset.MoveNext
Loop


' Save spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath2
objExcel.ActiveWorkbook.Close

' Quit Excel and clean up.
objExcel.Application.Quit
objExcel.Application.Quit
adoRecordset.Close
adoConnection.Close

Function OctetToHexStr(ByVal arrbytOctet)
' Function to convert OctetString (byte array) to Hex string.
Dim k
OctetToHexStr = ""
For k = 1 To Lenb(arrbytOctet)
OctetToHexStr = OctetToHexStr _
& Right("0" & Hex(Ascb(Midb(arrbytOctet, k, 1))), 2)
Next
End Function

Wscript.Echo "Report Generated
 
Sort by date Sort by votes
what line is 86?

-Geates

"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer
 
Upvote 0 Downvote
' Run the query.
Set adoRecordset = adoCommand.Execute ' Line 76


Of course, I see "Line 76" should not be shown in the code.
 
Upvote 0 Downvote
back track to find out where the error lies.

adoCommand.Execute runs the adoCommand.CommandText
adoCommand.CommandText is equal strQuery
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

The error says the "table does not exist" meaning the table in strQuery. Make sure strQuery is built correctly by checking it's components.

strBase = ??
strFilter = ??
strAttributes = ??

My guess is the problem lies here
Code: 
strBaseOU = "OU=XX,OU=Accounts"
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strBaseOU & "," & strDNSDomain & ">"

If everything seems to be in order, ask yourself if anything in the environment has changed. New Domain? AD configuration?

-Geates


"I hope I can chill and see the change - stop the bleed inside and feel again. Cut the chain of lies you've been feeding my veins; I've got nothing to say to you!"
-Infected Mushroom

"I do not offer answers, only considerations."
- Geates's Disclaimer
 
Upvote 0 Downvote
I use it at my work and I don't know what it is that I am trying to verify or how to. I just know it worked great for months. If there is a change I don't know what or how to see. It left me wondering how to find out and what needs to be changed in the code.
 
Upvote 0 Downvote
I was able to fix it.

strBaseOU = "OU=XX,OU=Accounts"


I saw there was a new folder before "Accounts". I added the new OU folder in two locations in the script and now it works.

Thanks for taking the time to help. Looking at the OU section you posted helped me to see the issue, thanks!
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

bdwilcox
  • Locked
  • Question
Trying to adapt VBScript to search if machine is in an AD group 6
Replies
8
Views
1K
SoftwareRT
SoftwareRT
bdwilcox
  • Locked
  • Question
Script seeing input variable value as blank but sees hard-coded value 4
Replies
6
Views
679
bdwilcox
bdwilcox
Alexvb6
  • Locked
  • Question
Deprecation of VBScript + Classic ASP: How to Ask Microsoft to cancel their planned craziness
Replies
0
Views
361
Alexvb6
Alexvb6
Don Child
  • Locked
  • Question
How to validate an INSERT, after Executing
Replies
1
Views
274
Don Child
Don Child
bdwilcox
  • Locked
  • Question
Validate that HTA text input boxes aren't blank on submission
Replies
1
Views
273
bdwilcox
bdwilcox

Part and Inventory Search

Sponsor

Back
Top