I have been working on this problem for days, and I am struggling to find a solution that works.
Basically, I want a function in the following form:
That returns 1 if the the username is in the group, and 0 otherwise. Does anyone have any sources or solutions for this problem? I am trying to work with the following code:
Function GetMembers(gDN) Set objGroup = GetObject("LDAP://" & gDN) objGroup.GetInfo arrMemberOf = objGroup.GetEx("member") For Each strMember in arrMemberOf Set objMember = GetObject("LDAP://" & strMember) ObjDisp = objMember.Name oDL = Len(ObjDisp) - 3 ObjDisp = Right(ObjDisp,oDL) ObjCatArray = Split(objMember.objectCategory,",") oType = ObjCatArray(0) oTL = Len(oType) - 3 oType = Right(oType,oTL) msgbox "Member:" & ObjDisp & Space(20-Len(ObjDIsp)) &" Type:" & oType If oType = "Group" Then GetMembers(strMember) End If Set objMember = Nothing Next End Function Public Function SearchGroup(ByVal vSAN) 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=Group)(samAccountName=" & vSAN & "));distinguishedName;subtree" Set oRecordSet = oCommand.Execute On Error Resume Next SearchGroup = oRecordSet.Fields("distinguishedName") On Error GoTo 0 oConnection.Close Set oRecordSet = Nothing Set oCommand = Nothing Set oConnection = Nothing Set oRootDSE = Nothing End Function
Function IsMember(ByVal objADObject, ByVal strGroupNTName) ' Function to test for group membership. ' objADObject is a user or computer object. ' strGroupNTName is the NT name (sAMAccountName) of the group to test. ' objGroupList is a dictionary object, with global scope. ' Returns True if the user or computer is a member of the group. ' Subroutine LoadGroups is called once for each different objADObject. Dim objRootDSE, strDNSDomain ' The first time IsMember is called, setup the dictionary object ' and objects required for ADO. If (IsEmpty(objGroupList) = True) Then Set objGroupList = CreateObject("Scripting.Dictionary") objGroupList.CompareMode = vbTextCompare Set adoCommand = CreateObject("ADODB.Command") Set adoConnection = CreateObject("ADODB.Connection") adoConnection.Provider = "ADsDSOObject" adoConnection.Open "Active Directory Provider" adoCommand.ActiveConnection = adoConnection Set objRootDSE = GetObject("LDAP://RootDSE") strDNSDomain = objRootDSE.Get("defaultNamingContext") adoCommand.Properties("Page Size") = 100 adoCommand.Properties("Timeout") = 30 adoCommand.Properties("Cache Results") = False ' Search entire domain. strBase = "<LDAP://" & strDNSDomain & ">" ' Retrieve NT name of each group. strAttributes = "sAMAccountName" ' Load group memberships for this user or computer into dictionary ' object. Call LoadGroups(objADObject) Set objRootDSE = Nothing End If If (objGroupList.Exists(objADObject.sAMAccountName & "\") = False) Then ' Dictionary object established, but group memberships for this ' user or computer must be added. Call LoadGroups(objADObject) End If ' Return True if this user or computer is a member of the group. IsMember = objGroupList.Exists(objADObject.sAMAccountName & "\" & strGroupNTName) End Function
Thoughts? Bonus points if the solution uses "Safe Mode" instead of "System Access." Thanks for your help.