Populate a Sheet with Active Directory Computers

[davery83]

Hi
I'm looking to add Computers from AD to a sheet, any ideas on how this is possible? I've seen code for AD but I can't find any relating to the computer objects.
Is it also possible to find out where each computer is in the AD tree?
Thanks!

[Bob Phillips]

What have you tried?

[davery83]

What have you tried?

Well not a lot so far, all google returns in the search is user related AD queries. I wouldn't know where to start with this.....

[Bob Phillips]

I don't use AD, but I found this code, but not sure how relevant it is



Sub TestHarness
Set objTrans = CreateObject("NameTranslate")

objTrans.Set 3, "<domainname>\<servername>$"
strComputerDN = objTrans.Get(1)

Set objComputer = GetObject("LDAP://" & strComputerDN)
colGroups = objComputer.MemberOf

For i = 0 To UBound(colGroups)
ActiveCell.Value = GetGroup(colGroups(i))
ActiveCell.Offset(1, 0).Select
Next
End Sub

Function GetGroup(strGroup) As String
z = Split(strGroup, ",")
If Left(z(0), 3) = "CN=" Then
GetGroup = Right(z(0), Len(z(0)) - 3)
Else
GetGroup = ""
End If
End Function

[davery83]

Thanks for the reply.
I've amended that so that the location of the computer entered is added to a listbox, however I'd like to be able for it to run through Active Directory and add the Computer names too, not just the one entered.
Here is my code so far:

Private Sub CommandButton19_Click()
Set objTrans = CreateObject("NameTranslate")

objTrans.Set 3, "domain\computer$"
strComputerDN = objTrans.Get(1)

Set objComputer = GetObject("LDAP://" & strComputerDN)


ListBox4.AddItem objComputer.Location



End Sub

[Bob Phillips]

Don't know enough about AD to help I am afraid.

[Aflatoon]

This will populate a worksheet with the names:


Private Sub GetComputerList()
Const ADS_SCOPE_SUBTREE = 2
Set objRoot = GetObject("LDAP://rootDSE")
'Work in the default domain
strDomain = objRoot.Get("defaultNamingContext")

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

Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = _
"SELECT Name FROM 'LDAP://" & strDomain & "' WHERE objectClass='computer'"
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordset = objCommand.Execute
ActiveSheet.Range("A2").CopyFromRecordset objRecordset
objRecordset.Close
ObjConnection.Close
End Sub


You would need to alter it to use GetRows and then transpose the array, or loop and use AddItem in order to populate your listbox.

[davery83]

Thats done it, thanks! Just gotta sort it out now :)