All,
I am looking for some insight for a problem I am having in doing a series of
calls to AD to populate a recordset.
The error I receive is:
(null): The server is not operational.
On this line of code:
Set objTarget = GetObject("LDAP://" & strDN & "," & Domain)
This usually happens on the 1979 to 1984 call to AD. I have rebuilt the
workstation (XP SP2) and the DC (WIN2K SP4) is a saved state virtual machine
I can roll back to a baseline at will. Everything was running fine up to a
couple days ago and I have reverted the code to a state that runs fine, but
there is no functional difference in the current to the reverted code.
ADUC will not pull up properties on a Group for a couple minutes after the
error, displaying the "Server is not Operational" message on a blank object
window. I have run traces on the workstation and server and nothing is out of
the ordinary.
I am stumped, in 6 years of ADSI this one is a new one on me. I am sure
there is some boneheaded error or something I am overlooking. Any insight as
to where I am going wrong is appreciated.
Thanks,
Jay
Relevant Code:
'******************************************************************
' Takes in a Rollup dataset and populates AD Dataset
' With the groups updated data
Sub Populate_AD_DS(ByRef DSClone, ByRef AD_DS)
' Globals: Domain
Dim strDN, strSamName, sGroupName
'Dim objTarget
Dim iCount, iGCount
iCount = 0
iGCount = 0
If NOT DSClone.BOF = True Then
DSClone.MoveFirst
End If
Do Until DSClone.EOF
sGroupName = ""
strSamName = ""
strSamName = DSClone("SamName")
'Wscript.Echo strSamName
strDN = Get_ADDN(strSamName)
If strDN <> "" Then
'Wscript.Echo strDN
' Create Entry in AD_Recordset
AD_DS.AddNew
AD_DS("DN") = strDN
AD_DS("OldDN") = DSClone("DN")
AD_DS("SamName") = strSamName
' Attach to the Group Object
'Wscript.Echo strDN & "," & Domain
Dim objTarget
'Set objTarget = GetObject(strLDAP & strDN & "," & Domain)
Set objTarget = GetObject("LDAP://" & strDN & "," & Domain)
' Remove CN= from Name
sGroupName = Mid(objTarget.Name, 4)
AD_DS("Name") = sGroupName
'Wscript.Echo vbtab & sGroupName
'******************************************************************
'Get List of Members
Dim sGroupMember, sGroupMemberDN, sMemberList
Dim arrMembers, iMemberCount
sGroupMember = ""
sMemberList = ""
iMemberCount = 0
'*********************
On Error Resume Next
'*********************
arrMembers = objTarget.GetEx("member")
'Wscript.Echo vbtab & "Get Members"
If Err.Number = 0 Then
' Group has members
iMemberCount = Ubound(arrMembers) + 1
' If count >=1000 need to process group membership differently
If iMemberCount >= 1000 Then
arrMembers = Get_LargeMembership(strSamName)
iMemberCount = Ubound(arrMembers) + 1
End If ' iMemberCount >= 1000
For Each sGroupMemberDN in arrMembers
' Strip off the dc=... part of the DN for storage
sGroupMember = Replace(sGroupMemberDN, "," & Domain, "")
' Build list of members
If sMemberList = "" Then
sMemberList = sGroupMember
Else
sMemberList = sMemberList & ";" & sGroupMember
End If ' sMemberList = ""
Next ' sGroupMemberDN in arrMembers
End If ' Err.Number <> 0 Members Check
'*********************
Err.Clear
On Error GoTo 0
'*********************
AD_DS("MemberList") = sMemberList
' Save Changes to AD_Recordset
AD_DS.Update
Set objTarget = Nothing
End If ' strDN <> ""
iCount = iCount + 1
iGCount = iGCount + 1
Wscript.Echo iGCount
' Pause every 1000 transactions for AD to rest
If iCount >= 1000 Then
iCount = 0
Wscript.Sleep 20000
End If
DSClone.MoveNext
Loop ' Until DSClone.EOF
End Sub ' Populate_AD_DS
'******************************************************************
' Connects to Groups with >= 1000 members and itterates all members
' Based on code by Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
Function Get_LargeMembership(strSamName)
'Globals: Domain, objADConn
'******************************************************************
' Create Active Directory Command
Dim objCmd
Set objCmd = CreateObject("ADODB.Command")
Set objCmd.ActiveConnection = objADConn
'******************************************************************
' Create dictionary object to store Members
Dim oMemberList
Set oMemberList = CreateObject("Scripting.Dictionary")
oMemberList.CompareMode = vbTextCompare
' Create LDAP Search variables
Dim strPath, strFilter, strAttr, strScope
strPath = "<LDAP://" & Domain & ">;"
strFilter ="(&(objectCategory=group)(sAMAccountName=" & strSamName & "));"
strAttr = "member;"
strScope ="subtree"
objCmd.Properties("Page Size") = 100
objCmd.Properties("Timeout") = 60
objCmd.Properties("Cache Results") = False
Dim boolLast, iRangeStep, iLowRange, iHighRange, iCount
boolLast = False
iRangeStep = 999
iLowRange = 0
iHighRange = iLowRange + iRangeStep
Dim objRS, sQuery, boolSearch
boolSearch = True
Do While boolSearch
If boolLast Then
sQuery = strPath & strFilter & strAttr & _
"range=" & iLowRange & "-*;" & strScope
Else
sQuery = strPath & strFilter & strAttr & _
"range=" & iLowRange & "-" & iHighRange & ";" & strScope
End If ' boolLast
' Do AD Search
objCmd.CommandText = sQuery
Set objRS = objCmd.Execute
iCount = 0
Dim arrMemberDN, sMemberDN, sMember
Dim objField
While Not objRS.EOF
For Each objField In objRS.Fields
If (VarType(objField) = (vbArray + vbVariant)) Then
For Each sMemberDN In objField.Value
' Strip off the dc=... part of the DN for storage
sMember = Replace(sMemberDN, "," & Domain, "")
If NOT oMemberList.Exists(sMember) Then
oMemberList.Add sMember, sMemberDN
iCount = iCount + 1
End If ' oMemberList.Exists(sMember) = False
Next ' sMemberDN In arrMemberDN
End If ' (VarType(objField) = (vbArray + vbVariant))
Next ' objField In objRS.Fields
objRS.MoveNext
Wend ' Not objRS.EOF
If boolLast Then
boolSearch = False
End If ' boolLast
If iCount = 0 Then
boolLast = True
Else
iLowRange = iHighRange + 1
iHighRange = iLowRange + iRangeStep
End If ' iCount = 0
Loop ' While boolSearch
' Close AD Objects
Set objRS = Nothing
Set objCmd = Nothing
' Wscript.Echo vbcrlf & "Large Group Count: " & oMemberList.Count
Dim arrMemberList
arrMemberList = oMemberList.Items
Set oMemberList = Nothing
' Return Array of members
Get_LargeMembership = arrMemberList
End Function ' Get_LargeMembership