Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Querying the Active Directory

Posted on 2003-11-25
3
Medium Priority
?
739 Views
Last Modified: 2012-08-14
Hi,

I want to query the Active Directory to retrieve users based on certain criteria, like 'l', 'Department', 'ReportsTo', 'ReportsFrom', etc., but I am not able to do so via ADSI.
I tried querying the Global Catalog (GC), but it is telling that these fields were not found in the directory cache. Can anyone help??

Thanks in advance,
nganesh.
0
Comment
Question by:nganesh
3 Comments
 
LVL 14

Accepted Solution

by:
waty earned 450 total points
ID: 9830924
' #Mandix Repository#************************************************************
' * Programmer Name  : Paul Gorman
' * WebSite          : http://www.smi-texas.com
' * Date             : 06/27/2002
' **********************************************************************
' * Comments         : Active Directory Search Functions
' *
' * There are 4 different function that allow you to search your
' * companies active directory in different ways. These function
' * will allow you to search active directory by user or by group
' * to determine permissions. I am currently using these in my enterprise
' * applications so that I can set up security at a very granular
' * level. Down to a specific control if i want to.
' *
' **********************************************************************

Option Explicit
Public Enum Enum_adscAccessType
   adscDenyedAccess = 0
   adscDataReader = 1
   adscDataWriter = 2
End Enum
Public Function AllowAccess(LoginID As String, Group As String) As Boolean
   Dim oCN              As ADODB.Connection, oCM As ADODB.Command, oRS As ADODB.Recordset, oField As ADODB.Field
   Dim oUser            As IADs, oParent As IADs, oGroup As IADs
   Dim oPropList        As IADsPropertyList, oPropEntry As IADsPropertyEntry, oPropVal As IADsPropertyValue
   Dim sPath            As String, v As Variant, i As Variant
   'This function checks a specific users rights via their login and what ever group you pass in.
   'You will need to replace the {YOUR DC HERE} with your own domain controller to active directory.
   Set oCN = New ADODB.Connection
   Set oCM = New ADODB.Command
   Set oRS = New ADODB.Recordset
   oCN.Provider = "ADsDSOObject"
   oCN.Open
   Set oCM.ActiveConnection = oCN
   oCM.CommandText = "SELECT AdsPath FROM 'LDAP://OU=Branches,OU=Corp,DC={YOUR DC HERE},DC=com' " & _
      "WHERE objectCategory='person' AND cn='" & LoginID & "'"
   oCM.Properties("searchscope") = 2
   Set oRS = oCM.Execute
   If Not oRS.EOF Then
      Set oUser = GetObject(oRS("AdsPath").Value)
      oUser.GetInfo
      Set oParent = GetObject(oUser.Parent)
      Set oParent = GetObject(oParent.Parent)
      For i = 0 To oUser.PropertyCount - 1
         Set oPropEntry = oUser.Item(i)
         If oPropEntry.Name = "memberOf" Then
            For Each v In oPropEntry.Values
               Set oPropVal = v
               sPath = oPropVal.DNString
               Set oGroup = GetObject("LDAP://" & sPath)
               If oGroup.Name = "CN=" & Group Then
                  AllowAccess = True
                  GoTo ShutDown
               End If
               Set oGroup = Nothing
            Next
         End If
         oUser.Next
      Next
   End If
   AllowAccess = False
ShutDown:
   Set oCN = Nothing
   Set oRS = Nothing
   Set oCM = Nothing
   Set oField = Nothing
   Set oUser = Nothing
   Set oParent = Nothing
   Set oGroup = Nothing
   Set oPropList = Nothing
   Set oPropEntry = Nothing
   Set oPropVal = Nothing
   Set v = Nothing
End Function

Public Function ADSCAllowAccessByGroup(Group As String, UserName As String) As Boolean
   On Error Resume Next
   Dim oGroup           As ActiveDs.IADsGroup
   Dim oUser            As ActiveDs.IADsUser
   'This function checks whether or not a user is in a specific group. It will return a true or false
   'You will need to replace the {YOUR DC HERE} with your own domain controller to active directory.
   Set oGroup = GetObject("WinNT://{YOUR DC HERE}.com/" & Group)
   If oGroup Is Nothing Then
      ADSCAllowAccessByGroup = False
      Exit Function
   End If
   For Each oUser In oGroup.Members
      Debug.Print oUser.Name
      If UCase(oUser.Name) = UCase(UserName) Then
         ADSCAllowAccessByGroup = True
         Exit Function
      End If
   Next
   ADSCAllowAccessByGroup = False
End Function

Public Function ADSCAllowAccessByUser(UserName As String, Group As String) As Boolean
   On Error Resume Next
   Dim oGroup           As ActiveDs.IADsGroup
   Dim oUser            As ActiveDs.IADsUser
   Set oUser = GetObject("WinNT://{YOUR DC HERE}.com/" & UCase(UserName) & ",user")
   If oUser Is Nothing Then
      ADSCAllowAccessByUser = False
      Exit Function
   End If
   For Each oGroup In oUser.Groups
      If UCase(oGroup.Name) = UCase(Group) Then
         ADSCAllowAccessByUser = True
         Exit Function
      End If
   Next
End Function

Public Function ADSCAccessType(Location As String, UserName As String, Module As String, AppName As String) As Enum_adscAccessType
   On Error Resume Next
   Dim oGroup           As ActiveDs.IADsGroup
   Dim oUser            As ActiveDs.IADsUser
   'This function assumes that you already have 2 types of groups set up. One that has DataReader at the end and another
   'that has datawriter at the end. It alsoassumes that you have set up your group name in the following
   'order: Location_AppName & Module & DataReader/DataWriter.
   'You can change this to fit your needs. The main part is the first line of code that sets the oUser
   'You will need to replace the {YOUR DC HERE} with your own domain controller to active directory.
   Set oUser = GetObject("WinNT://{YOUR DC HERE}.com/" & UCase(UserName) & ",user")
   If oUser Is Nothing Then
      ADSCAccessType = adscDenyedAccess
      Exit Function
   End If
   For Each oGroup In oUser.Groups
      Select Case oGroup.Name
         Case Location & "_" & AppName & Module & "DataReader"
            ADSCAccessType = adscDataReader
            Exit Function
         Case Location & "_" & AppName & Module & "DataWriter"
            ADSCAccessType = adscDataWriter
            Exit Function
      End Select
   Next
   ADSCAccessType = adscDenyedAccess
End Function
0

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

927 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question