Having an issue searching Global Directory

[bisk]

I have written a scrip that will query our Active Directory for users in a specific domain\group and now I need to be able to connect to our Global Directory to get thier Employee Number and Transit Number(custom field I'm told). I'm not too sure what I need to do to get this working.

On Error Resume Next

set WshShell = CreateObject("WScript.Shell")
set FSO = CreateObject("Scripting.FileSystemObject")
Set objDOM = CreateObject("Microsoft.XMLDOM")

' Connection to AD **************************************
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
' *******************************************************

ProfileXML = "\\s3w01904\g$\bisk\Stats\Profiles.xml"
TotalsFile = "\\s3w01904\g$\bisk\Stats\totals.txt"
DetailsFile = "\\s3w01904\g$\bisk\Stats\details.txt"
excelDetails = "\\s3w01904\g$\bisk\Stats\Details.csv"
excelPath = "\\s3w01904\g$\bisk\Stats\Users.csv"

Const Increment = 1500
LowRange = 0    
HighRange = int(increment) - 1

DeleteFile (excelPath)
DeleteFile (excelDetails)
DeleteFile (TotalsFile)
DeleteFile (DetailsFile)

Set objExcelFile = FSO.CreateTextFile(excelPath)
Set objExcelFileDetails = FSO.CreateTextFile(excelDetails)

objExcelFile.WriteLine "SCENARIO,FISCAL_PERIOD,COST_CENTRE,SERV_CODE,OPT_CODE,CNSIND,VOL,EMPNUM,
REMARKS,USER_NAME"
objExcelFileDetails.WriteLine "Monthly Cost,Yearly Cost,Details"

If FSO.FileExists (ProfileXML) Then
	objDom.ValidateOnParse = True
	objDom.Load(ProfileXML)

	For Each ProfileNode in objDom.GetElementsByTagName("Stats/Profile")
		ProfileName = ProfileNode.GetAttribute("Name")
		MonthlyCost = ProfileNode.GetAttribute("Cost")
		AddTextToFile DetailsFile , "***********************************************************"
		AddTextToFile DetailsFile , "Profile - " & ProfileName
		TotalUsers = 0
		For Each GroupNode in ProfileNode.GetElementsByTagName("Group")
			GroupName = GroupNode.GetAttribute("Name")

			If GroupName = "WTS RBCI - Liberty" then
				GroupName = "WTS RBCI – Liberty"
			End If

			Domain = GroupNode.GetAttribute("Domain")

			bDone = False
			UserCount = 0
			LowRange = 0
			HighRange = int(increment) - 1

			If UCASE(Domain) = "PLATINUM" Then
                                'For NT4 Domain
				Set objGroup = GetObject("WinNT://" & Domain & "/" & GroupName)
				Set MemberList = objGroup.Members

				For Each Member In MemberList
					UserCount = int(UserCount) + 1
					CurrentRow = CurrentRow + 1
					objExcelFile.WriteLine ",,Transit Number,,,,,Emp Number," & ProfileName & "," & Member.Name
				Next

			Else
				strDomainFQDN = "DC=" & Domain & ",DC=FG,DC=RBC,DC=COM"

				objCommand.CommandText = _
					"<GC://" & strDomainFQDN & ">;" & _
					"(&(objectCategory=group)" & _
					"(sAMAccountName=" & GroupName & "));" & _
					"DistinguishedName;subtree"

				Set objRecordSet = objCommand.Execute
			
				If objRecordSet.RecordCount <> 0 Then
					strDN = objRecordSet.Fields("DistinguishedName")

					strDN = replace(strDN , "/" , "\/")

					set objGroup = GetObject("LDAP://" & strDN)

					While Not bDone
						strRange = "member;range=" & lowRange & "-" & highRange

						objGroup.GetInfoEx Array(strRange), 0          

					        MemberList = objGroup.GetEx("member")      

						For Each Member in MemberList
							If Member <> "" Then
								UserCount = int(UserCount) + 1
								set Objuser = GetObject("LDAP://" & Member)
								objExcelFile.WriteLine ",,Transit Number,,,,," & objuser.employeeid & "," & ProfileName & "," & objuser.displayname
							End If
						Next

        					If int(UserCount) - 1 = HighRange Then  
							'still more users in the group
							bDone = False
						Else
							'quits loop on short group or end of long group
							bDone = True
						End If

						LowRange = LowRange + Increment
       						HighRange = HighRange + Increment
					Wend
				End If
			End If

			Set objRecordSet = nothing
			Set obGroup = nothing
			Set MemberList = nothing
			Set objUser = nothing

			AddTextToFile DetailsFile , Domain & "\" & GroupName & " - " & UserCount
			TotalUsers = int(TotalUsers) + int(UserCount)

		Next

	AddTextToFile DetailsFile , "Total - " & TotalUsers
	AddTextToFile TotalsFile , ProfileName & " - " & TotalUsers

	TotalMonthlyCost = int(TotalUsers) * int(MonthlyCost)
	TotalYearlyCost = 12 * int(TotalMonthlyCost)
	objExcelFileDetails.WriteLine TotalMonthlyCost & "," & TotalYearlyCost & "," & ProfileName & " - " & TotalUsers & " users @ $" & MonthlyCost & " per month"

	Next

	AddTextToFile TotalsFile , "DONE!"

else
	wscript.echo "XML doesn't exist"
end if

wscript.quit

'***************************************************************

Sub AddTextToFile(Filename, Text)
	CONST FOR_APPENDING = 8
	With FSO.OpenTextFile(Filename, FOR_APPENDING, True)
		.WriteLine Text
	End With
End Sub

Sub DeleteFile (Filename)
	If FSO.FileExists (Filename) Then
		FSO.DeleteFile Filename
	End If
End Sub

 

[markdmac]

Where you have this:

For Each Member In MemberList
UserCount = int(UserCount) + 1
CurrentRow = CurrentRow + 1
objExcelFile.WriteLine ",,Transit Number,,,,,Emp Number," & ProfileName & "," & Member.Name
Next

Add the following code inside the for next:

Set objUser = GetObject("LDAP://" & SearchDistinguishedName(Right(Member.Name),Len(Member.Name)-3))
objUser.GetInfo

EmpNumber = objUser.employeeNumber
TransitNumber = objUser.TransitNumber

Then add the following function to the bottom of your code

Public Function SearchDistinguishedName(ByVal vSAN)
    ' Function:     SearchDistinguishedName
    ' Description:  Searches the DistinguishedName for a given SamAccountName
    ' Parameters:   ByVal vSAN - The SamAccountName to search
    ' Returns:      The DistinguishedName Name
    Dim oRootDSE, oConnection, oCommand, oRecordSet

    Set oRootDSE = GetObject("LDAP://rootDSE")
    Set oConnection = CreateObject("ADODB.Connection")
    oConnection.Open "Provider=ADsDSOObject;"
    Set oCommand = CreateObject("ADODB.Command")
    oCommand.ActiveConnection = oConnection
    oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
        ">;(&(objectCategory=User)(samAccountName=" & vSAN & "));distinguishedName;subtree"
    Set oRecordSet = oCommand.Execute
    On Error Resume Next
    SearchDistinguishedName = oRecordSet.Fields("DistinguishedName")
    On Error GoTo 0
    oConnection.Close
    Set oRecordSet = Nothing
    Set oCommand = Nothing
    Set oConnection = Nothing
    Set oRootDSE = Nothing
End Function

note that I am doing the following: Right(Member.Name),Len(Member.Name)-3) because when you enumerate group members from a recordset the member name would be something like: cn=jsmith.



I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[PHV]

Mark, instead of:
Right(Member.Name),Len(Member.Name)-3)
why not simply this ?
Mid(Member.Name, 4)

 

[markdmac]

Great suggestion PHV. Either works of course but yours is much more concise and therefore a better suggestion. Thanks for adding to the thread.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[bisk]

Thanks guys, but I had to make a couple changes to the code:

I had to change:

Set objUser = GetObject("LDAP://" & SearchDistinguishedName(Right(Member.Name),Len(Member.Name)-3))

to

Set objUser = GetObject("LDAP://" & SearchDistinguishedName(Member))

I also changed the function to this

Public Function SearchDistinguishedName(ByVal vSAN)
	' Function:     SearchDistinguishedName
	' Description:  Searches the DistinguishedName for a given SamAccountName
	' Parameters:   ByVal vSAN - The SamAccountName to search
	' Returns:      The DistinguishedName Name
	Dim oRootDSE, oConnection, oCommand, oRecordSet

	Set oRootDSE = GetObject("LDAP://RootDSE")
	Set oConnection = CreateObject("ADODB.Connection")
	oConnection.Properties("User ID") = "ou=LR05,ou=applications,dc=fg,dc=rbc,dc=com"
	oConnection.Properties("Password") = "Larry05"
	oConnection.Open "Provider=ADsDSOObject;"
	Set oCommand = CreateObject("ADODB.Command")
	oCommand.ActiveConnection = oConnection
	oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
		">;(&(objectCategory=User)(samAccountName=" & vSAN & "));distinguishedName;subtree"
	Set oRecordSet = oCommand.Execute
	On Error Resume Next
	SearchDistinguishedName = oRecordSet.Fields("DistinguishedName")
	On Error GoTo 0
	oConnection.Close
	Set oRecordSet = Nothing
	Set oCommand = Nothing
	Set oConnection = Nothing
	Set oRootDSE = Nothing
End Function

But it doesn't appear to be working as I get an error on the line containing oConnection.Open "Provider=ADsDSOObject;" saying that the supplied provider is different than the one in use.

 

[markdmac]

Are you trying to run this on the server? You can't provide different credentials locally.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[bisk]

Nope, not from the Domain Controller, but I am running it from a server.

 

[markdmac]

Laat time I used the oConnection.Properties("User ID") method I only needed to use the samAccountName not the DN for the user.

Not sure if that woudl be the problem or not but I have to wonder why you needed to make that change in the first place. Why does the account you are running on the server not have read rights to AD?

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[bisk]

I am querying our Active Directory to get the members of certain groups (which my ID has access to do) and then I need to query our Global Directory/Catalog to get each respective user's Employee ID and Transit number.

 

[bisk]

Anyone have any ideas?

 

[markdmac]

Did you ever try this:

Set objUser = GetObject("LDAP://" & SearchDistinguishedName(Right(Member.Name),Len(Member.Name)-3))
objUser.GetInfo

EmpNumber = objUser.employeeNumber
TransitNumber = objUser.TransitNumber

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[bisk]

Yes I did and I'm getting the following error:
CollectStats.vbs(201, 2) ADODB.Connection: Supplied provider is different from the one already in use.

Here's the code

'On Error Resume Next

set WshShell = CreateObject("WScript.Shell")
set FSO = CreateObject("Scripting.FileSystemObject")
Set objDOM = CreateObject("Microsoft.XMLDOM")

' Connection to AD **************************************
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
' *******************************************************

ProfileXML = "\\s3w01904\g$\bisk\Stats\Profiles.xml"
DetailsFile = "\\s3w01904\g$\bisk\Stats\details.txt"
excelDetails = "\\s3w01904\g$\bisk\Stats\Details.csv"
excelPath = "\\s3w01904\g$\bisk\Stats\Users.csv"
excelTotals = "\\s3w01904\g$\bisk\Stats\totals.csv"

Const Increment = 1500
LowRange = 0    
HighRange = int(increment) - 1

DeleteFile (excelPath)
DeleteFile (excelTotals)
DeleteFile (excelDetails)
DeleteFile (DetailsFile)

Set objExcelFile = FSO.CreateTextFile(excelPath)
Set objExcelFileDetails = FSO.CreateTextFile(excelDetails)
Set objExcelTotals = FSO.CreateTextFile(excelTotals)

objExcelFile.WriteLine "SCENARIO,FISCAL_PERIOD,COST_CENTRE,SERV_CODE,OPT_CODE,CNSIND,VOL,EMPNUM,REMARKS,USER_NAME"
objExcelFileDetails.WriteLine ",Monthly Cost,Yearly Cost,Details"

If FSO.FileExists (ProfileXML) Then
	objDom.ValidateOnParse = True
	objDom.Load(ProfileXML)

	For Each ProfileNode in objDom.GetElementsByTagName("Stats/Profile")
		MonthlyName = ProfileNode.GetAttribute("Monthly")
		QuarterlyName = ProfileNode.GetAttribute("Quarterly")
		MonthlyNumber = ProfileNode.GetAttribute("MNum")
		QuarterlyNumber = ProfileNode.GetAttribute("QNum")
		MonthlyCost = ProfileNode.GetAttribute("Cost")
		AddTextToFile DetailsFile , "*********************************************************************************"
		AddTextToFile DetailsFile , "Profile - " & MonthlyName
		TotalUsers = 0
		For Each GroupNode in ProfileNode.GetElementsByTagName("Group")
			GroupName = GroupNode.GetAttribute("Name")
			InputNumbers = GroupNode.GetAttribute("Input")
			ConstantTotal = GroupNode.GetAttribute("Constant")

			If GroupName = "WTS RBCI - Liberty" then
				GroupName = "WTS RBCI – Liberty"
			End If

			Domain = GroupNode.GetAttribute("Domain")

			bDone = False
			UserCount = 0
			LowRange = 0
			HighRange = int(increment) - 1

			If ConstantTotal <> "" then
				UserCount = ConstantTotal

			ElseIf UCASE(InputNumbers) = "YES" then
				Do While int(UserCount) = 0
					UserCount = InputBox(MonthlyName , "Enter the number of users")
				Loop

			ElseIf UCASE(Domain) = "PLATINUM" Then
				Set objGroup = GetObject("WinNT://" & Domain & "/" & GroupName)
				Set MemberList = objGroup.Members

				For Each Member In MemberList
					UserCount = int(UserCount) + 1
					CurrentRow = CurrentRow + 1

					Set objUser = GetObject("LDAP://" & SearchDistinguishedName(Member))
					objUser.GetInfo

					EmpNumber = objUser.employeeNumber
					TransitNumber = objUser.RBCUnit
				
					objExcelFile.WriteLine ",," & TransitNumber & ",,,,," & EmpNumber & "," & ProfileName & "," & objuser.displayname
					'objExcelFile.WriteLine ",,Transit Number,,,,,Emp Number," & QuarterlyName & "," & Member.Name
				Next

				AddTextToFile DetailsFile , Domain & "\" & GroupName & " - " & UserCount

			Else
				strDomainFQDN = "DC=" & Domain & ",DC=FG,DC=RBC,DC=COM"

				objCommand.CommandText = _
					"<GC://" & strDomainFQDN & ">;" & _
					"(&(objectCategory=group)" & _
					"(sAMAccountName=" & GroupName & "));" & _
					"DistinguishedName;subtree"

				Set objRecordSet = objCommand.Execute
			
				If objRecordSet.RecordCount <> 0 Then
					strDN = objRecordSet.Fields("DistinguishedName")

					strDN = replace(strDN , "/" , "\/")

					set objGroup = GetObject("LDAP://" & strDN)

					While Not bDone
						strRange = "member;range=" & lowRange & "-" & highRange

						objGroup.GetInfoEx Array(strRange), 0          

					        MemberList = objGroup.GetEx("member")      

						For Each Member in MemberList
							If Member <> "" Then
								UserCount = int(UserCount) + 1
								'set Objuser = GetObject("LDAP://" & Member)
								Set objUser = GetObject("LDAP://" & SearchDistinguishedName(Member))
								objUser.GetInfo

								EmpNumber = objUser.employeeNumber
								TransitNumber = objUser.RBCUnit
				
								objExcelFile.WriteLine ",," & TransitNumber & ",,,,," & EmpNumber & "," & ProfileName & "," & objuser.displayname
							End If
						Next

        					If int(UserCount) - 1 = HighRange Then  
							'still more users in the group
							bDone = False
						Else
							'quits loop on short group or end of long group
							bDone = True
						End If

						LowRange = LowRange + Increment
       						HighRange = HighRange + Increment
					Wend
				End If

				AddTextToFile DetailsFile , Domain & "\" & GroupName & " - " & UserCount
			End If

			Set objRecordSet = nothing
			Set obGroup = nothing
			Set MemberList = nothing
			Set objUser = nothing
			InputNumbers = ""
			ConstantTotal = ""

			TotalUsers = int(TotalUsers) + int(UserCount)

		Next

	AddTextToFile DetailsFile , "Total - " & TotalUsers
	objExcelTotals.WriteLine MonthlyNumber & "," & MonthlyName & "," & TotalUsers

	TotalMonthlyCost = int(TotalUsers) * int(MonthlyCost)
	TotalYearlyCost = 12 * int(TotalMonthlyCost)
	objExcelFileDetails.WriteLine QuarterlyNumber & "," & TotalMonthlyCost & "," & TotalYearlyCost & "," & QuarterlyName & " - " & TotalUsers & " users @ $" & MonthlyCost & " per month"

	Next

else
	wscript.echo "XML doesn't exist"
end if

wscript.quit

'*********************************************************************************************************

Sub AddTextToFile(Filename, Text)
	CONST FOR_APPENDING = 8
	With FSO.OpenTextFile(Filename, FOR_APPENDING, True)
		.WriteLine Text
	End With
End Sub

Sub DeleteFile (Filename)
	If FSO.FileExists (Filename) Then
		FSO.DeleteFile Filename
	End If
End Sub

Public Function SearchDistinguishedName(ByVal vSAN)
	' Function:     SearchDistinguishedName
	' Description:  Searches the DistinguishedName for a given SamAccountName
	' Parameters:   ByVal vSAN - The SamAccountName to search
	' Returns:      The DistinguishedName Name
	Dim oRootDSE, oConnection, oCommand, oRecordSet

	Set oRootDSE = GetObject("LDAP://RootDSE")
	Set oConnection = CreateObject("ADODB.Connection")
	oConnection.Properties("User ID") = "ou=LR05,ou=applications,dc=fg,dc=rbc,dc=com"
	oConnection.Properties("Password") = "Larry05"
	oConnection.Open "Provider=ADsDSOObject;"
	Set oCommand = CreateObject("ADODB.Command")
	oCommand.ActiveConnection = oConnection
	oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
		">;(&(objectCategory=User)(samAccountName=" & vSAN & "));distinguishedName;subtree"
	Set oRecordSet = oCommand.Execute
	On Error Resume Next
	SearchDistinguishedName = oRecordSet.Fields("DistinguishedName")
	On Error GoTo 0
	oConnection.Close
	Set oRecordSet = Nothing
	Set oCommand = Nothing
	Set oConnection = Nothing
	Set oRootDSE = Nothing
End Function

 

[markdmac]

Did you try replacing this:
oConnection.Properties("User ID") = "ou=LR05,ou=applications,dc=fg,dc=rbc,dc=com"

With something like this:
oConnection.Properties("User ID") = "rbc\larry"

Or remove the credentials entirely? So long as you are running the script with an ID that has administrative rights and is in the same domain the credentials should not be needed.


I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[bisk]

Thanks!
By removing the following lines

oConnection.Properties("User ID") = "ou=LR05,ou=applications,dc=fg,dc=rbc,dc=com"
oConnection.Properties("Password") = "Larry05"

I'm getting the following error
CollectStats.vbs(123, 9) (null): 0x80005000
which is this line

Set objUser = GetObject("LDAP://" & SearchDistinguishedName(Member))

 

[markdmac]

Check to see what the value of Member is by echoing it out. It should be in the form of just the login name.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[bisk]

Nope, it's actually returning the following:
CN=Dias\, Kelly,OU=Business,OU=RBC Dexia Nat,OU=Accounts,DC=maple,DC=fg,DC=rbc,DC=com

 

[markdmac]

OK, so then you already have the distinguished name, so no need to call the function.

Just use this:

Set objUser = GetObject("LDAP://" & Member)

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[bisk]

Thanks for all of the help, but don't I need a way of quering a different LDAP database? As I am getting the DN from our login domain, but then I need to get their Employee Number and Transit Number from the Global Directory/Catalog.

 

[markdmac]

Why do you feel it is necesary to query a specific GC for this information? It should be available from any DC.

I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at

http://www.thespidersparlor.com/vbscript

Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.

 

[bisk]

I'm getting members of groups that are located in specific domains (like Maple.fg.rbc.com, birch.fg.rbc.com) and the "HR Information" like the user's Employee Number and Transit Number from GlobGDir.fg.rbc.com.