Active Directory Macro

[AndrewTrevayne]

Hello everyone. It has been a while since I last visited the forum. Luckily I still have my account valid.
I need some help on Active Directory Macro once again and I hope to find some help here.

I currently have a working macro, I just need it to be tweaked a bit.
Here is the code:

Sub Testing123()


ScreenUpdating = False
Set SheetX = Sheets("Data")


    RunMe SheetX.Range("C3").Value, Sheet2.Range("C6")

    
    
ScreenUpdating = True
End Sub

Sub RunMe(strGroup As String, rngOut As Range)

        Dim objConnection, objCommand, objRecordSet, objGroup, objRootDSE, objMember
        Dim strLine
        Dim wSheet As Worksheet
        For Each wSheet In Worksheets
        
    
Next wSheet

        Set objConnection = CreateObject("ADODB.Connection")
        objConnection.Provider = "ADsDSOObject"
        objConnection.Open "Active Directory Provider"
        
        Set objCommand = CreateObject("ADODB.Command")
        objCommand.ActiveConnection = objConnection

        Set objRootDSE = GetObject("LDAP://RootDSE")
        objCommand.CommandText = "SELECT aDSPath FROM 'LDAP://" & objRootDSE.Get("defaultNamingContext") & _
                            "' WHERE objectClass='group' And name='" & strGroup & "'"
        Set objRootDSE = Nothing
        objCommand.Properties("Page Size") = 1000
        objCommand.Properties("Timeout") = 600
        objCommand.Properties("Cache Results") = False
        Set objRecordSet = objCommand.Execute

        
        While Not objRecordSet.EOF
        Set objGroup = GetObject(objRecordSet.Fields("aDSPath"))
    
    For Each objMember In objGroup.Members
        rngOut.Value = objMember.Get("name")
        Set rngOut = rngOut.Offset(1)
        Next
        Set objGroup = Nothing
        objRecordSet.MoveNext
        Wend

        objConnection.Close
        Set objRecordSet = Nothing
        Set objCommand = Nothing
        Set objConnection = Nothing

End Sub

Basically, what it does is that it reads the Active Directory Security group in Cell C3 and then it displays the members of this group to Cell C6.
Is it possible to modify the code so that it reads all the Security groups in the same row? C3, D3.... etc. to the last column?
And then display the results from C6, D6... etc to the last column?

Looking forward to your help and many thanks in advance.

Regards,
Andrew

 

[JLGWhiz]

the code you posted does not do what your narrative indicates. The code is a database query.

 

[AndrewTrevayne]

the code you posted does not do what your narrative indicates. The code is a database query.

Hello, yes it is a code to query the active directory database.
It is working fine but I was hoping to modify it a bit so it reads all the Security group in row 3 (starting from column C).
Currently it only reads the Security Group in Cell C3.

Thank you in advance.

 

[JLGWhiz]

You have two sub procedures posted. The first one feeds target data to the second one. You only need to change the first one. Try this modified version of
'Testing123'.

Sub Testing123()
ScreenUpdating = False
Dim i As Long, lc As Long
lc = Sheets("Data").Cells(3, Columns.Count).End(xlToLeft).Column 'Assumes everything on this row is to be retrieved.
 For i = 3 To lc
      RunMe Sheets("Data").Cells(3, i).Value, Sheet2.Cells(6, i)
 Next    
ScreenUpdating = True
End Sub

 

[AndrewTrevayne]

You have two sub procedures posted. The first one feeds target data to the second one. You only need to change the first one. Try this modified version of
'Testing123'.

Sub Testing123()
ScreenUpdating = False
Dim i As Long, lc As Long
lc = Sheets("Data").Cells(3, Columns.Count).End(xlToLeft).Column 'Assumes everything on this row is to be retrieved.
 For i = 3 To lc
      RunMe Sheets("Data").Cells(3, i).Value, Sheet2.Cells(6, i)
 Next    
ScreenUpdating = True
End Sub

Thank you so much! Worked like a charm! Brilliant!

 

[JLGWhiz]

Thank you so much! Worked like a charm! Brilliant!

You're welcome,
Regards, JLG

 

[AndrewTrevayne]

Hello again, I think I celebrated too soon.
I followed your recommendation and the script now looks like this:

Sub Testing123()
ScreenUpdating = False
Dim i As Long, lc As Long
lc = Sheets("Data").Cells(3, Columns.Count).End(xlToLeft).Column
 For i = 3 To lc
      RunMe Sheets("Data").Cells(3, i).Value, Sheet2.Cells(6, i)
 Next
ScreenUpdating = True
End Sub


Sub RunMe(strGroup As String, rngOut As Range)

        Dim objConnection, objCommand, objRecordSet, objGroup, objRootDSE, objMember
        Dim strLine
        Dim wSheet As Worksheet
        For Each wSheet In Worksheets
        
    
Next wSheet

        Set objConnection = CreateObject("ADODB.Connection")
        objConnection.Provider = "ADsDSOObject"
        objConnection.Open "Active Directory Provider"
        
        Set objCommand = CreateObject("ADODB.Command")
        objCommand.ActiveConnection = objConnection

        Set objRootDSE = GetObject("LDAP://RootDSE")
        objCommand.CommandText = "SELECT aDSPath FROM 'LDAP://" & objRootDSE.Get("defaultNamingContext") & _
                            "' WHERE objectClass='group' And name='" & strGroup & "'"
        Set objRootDSE = Nothing
        objCommand.Properties("Page Size") = 1000
        objCommand.Properties("Timeout") = 600
        objCommand.Properties("Cache Results") = False
        Set objRecordSet = objCommand.Execute

        
        While Not objRecordSet.EOF
        Set objGroup = GetObject(objRecordSet.Fields("aDSPath"))
    
    For Each objMember In objGroup.Members
        rngOut.Value = objMember.Get("name")
        Set rngOut = rngOut.Offset(1)
        Next
        Set objGroup = Nothing
        objRecordSet.MoveNext
        Wend

        objConnection.Close
        Set objRecordSet = Nothing
        Set objCommand = Nothing
        Set objConnection = Nothing

End Sub

It is working fine but if there is blank field in row 3, I am getting an error on this line:

" While Not objRecordSet.EOF"

Any suggestions?
Thanks again.