John's Tech Tips

Code: Select all

function checkGroup(userName,ADgroupName)
Dim tUsers, rootDSE, domainDN, ldapfilter, ado, objectlist, groupDN, userDN
Dim logonName, displayName, logonNameUPN, groupRID, uType, oResponse,flag
flag = 0

Set rootDSE = GetObject("LDAP://rootDSE") 
domainDN = rootDSE.Get("defaultNamingContext")
ldapFilter = "(sAMAccountName=" & ADgroupName & ")"

Set ado = CreateObject("ADODB.Connection")
ado.Provider = "ADSDSOObject"
ado.Open "ADSearch" 
Set objectList = ado.Execute("<LDAP://" & domainDN & ">;" & ldapFilter & ";distinguishedName,primaryGroupToken;subtree")

groupDN = objectList.Fields("distinguishedName")
groupRID = objectList.Fields("primaryGroupToken")
                                           'search the members
ldapFilter = "(|(memberOf=" & groupDN & ")(primaryGroupID=" & groupRID & "))"

Set ado = CreateObject("ADODB.Connection")
ado.Provider = "ADSDSOObject"
ado.Open "ADSearch" 
Set objectList = ado.Execute("<LDAP://" & domainDN & ">;" & ldapFilter & ";distinguishedName,samAccountName,displayname,userPrincipalName;subtree,objectCategory")

While Not objectList.EOF
    userDN = objectList.Fields("distinguishedName")
    logonName = objectList.Fields("samAccountName")
    uType = objectList.Fields("objectCategory")
    On Error Resume Next
    displayName = "" : displayName = objectList.Fields("displayname")
    logonNameUPN = "" : logonNameUPN = objectList.Fields("userPrincipalName")
    On Error Goto 0
  
  logonName = logonName & " "
  
  if logonName = " " then logonName = logonNameUPN   
  if logonName = " " then logonName = "----"
  
  if mid(uType,4,6) = "Person" then
     if trim(lcase(logonName)) = trim(lcase(userName)) then 
       flag = 1 
     end if 
  end if 

    objectList.MoveNext
 Wend

 if flag = 1 then 
  checkGroup = true
 else
  checkGroup = false
 end if
end function