VBA - Excel - Computername und Bezeichnung(description) aus Active Directory auslesen. Win2003 Domäne
Ich versuche aus einer Active Directory (Win 2003 Domäne) alle beinhalteten Computer und deren Bezeichnungen, unabhängig vom Container in dennen sie sich befinden, auszulesen.
Habe schon lange im Netz nach pasenden lösungen gesucht, aber leider keine richtige gefunden.
Wie man die Computernamen auslesen kann, habe ich bereits gefunden, aber nicht, wie man die dazugehörige Bezeichnung ausliest.
Die eigentliche Ermittlung des Computernamens steht in einer Funktion.
Die übertragung der Daten nach Excel findet in einem Modul statt.
Den Code beider habe ich euch unten eingefügt.
Hoffe ihr könnt mir helfen, ich bekomme das Auslesen der Bezeichnung einfach nicht integriert in den bestehenden Code.
Eingebundene Bibliotheken:
- VIsual Basic for Applications
- Microsoft Excel 11.0 Object Libary
- OLE Automation
- Microsoft Office 11.0 Object Libary
- Microsoft Forms 2.0 Object Libary
- Microsoft ActiveX Data Objects 2.5 Libary
- Active DS Type Libary
- Microsoft Access 11.0 Object Libary
Funktion:
[Edit Biber] Codeformatierung nachgezogen [/Edit]
Habe schon lange im Netz nach pasenden lösungen gesucht, aber leider keine richtige gefunden.
Wie man die Computernamen auslesen kann, habe ich bereits gefunden, aber nicht, wie man die dazugehörige Bezeichnung ausliest.
Die eigentliche Ermittlung des Computernamens steht in einer Funktion.
Die übertragung der Daten nach Excel findet in einem Modul statt.
Den Code beider habe ich euch unten eingefügt.
Hoffe ihr könnt mir helfen, ich bekomme das Auslesen der Bezeichnung einfach nicht integriert in den bestehenden Code.
Eingebundene Bibliotheken:
- VIsual Basic for Applications
- Microsoft Excel 11.0 Object Libary
- OLE Automation
- Microsoft Office 11.0 Object Libary
- Microsoft Forms 2.0 Object Libary
- Microsoft ActiveX Data Objects 2.5 Libary
- Active DS Type Libary
- Microsoft Access 11.0 Object Libary
Funktion:
Public Function AllComputers() As String()
Dim conn As New Connection
Dim rs As Recordset
Dim Root As IADs
Dim Domain As IADs
Dim strBase As String
Dim strFilter As String
Dim strDomain As String
Dim strAttr As String
Dim strDepth As String
Dim strQuery As String
Dim strPC() As String
Dim nElement As Integer
On Error GoTo ErrHandler
ReDim strPC(0) As String
' Pfad der gegenwärtigen Domäne (LDAP) einholen
Set Root = GetObject("LDAP://rootDSE")
strDomain = Root.Get("defaultNamingContext")
Set Domain = GetObject("LDAP://" & strDomain)
' LDAP Base DN setzen
strBase = "<" & Domain.ADsPath & ">"
' Filter auf die Kategorie Computer setzen
strFilter = "(&(objectCategory=Computer))"
' Attribut setzen
strAttr = "name"
' Suchtiefe setzen
strDepth = "subTree"
' Abfrage zusammen setzen
strQuery = strBase & ";" & strFilter & ";" & strAttr & ";" & ";" & strDepth
Debug.Print strQuery
' Verbindung öffnen
conn.Open "Data Source=Active Directory Provider;Provider=ADsDSOObject"
' Query ausführen
Set rs = conn.Execute(strQuery)
Do While Not rs.EOF
If strPC(0) = "" Then
nElement = 0
Else
nElement = nElement + 1
End If
' das Array Redimensionieren
ReDim Preserve strPC(nElement) As String
' Den Computernamen in das Array schreiben
strPC(nElement) = rs("name")
rs.MoveNext
Loop
' Das StringArray zurückgeben
AllComputers = strPC
If rs.State <> 0 Then rs.Close
If conn.State <> 0 Then conn.Close
' Error Handling
ErrHandler:
On Error Resume Next
AllComputers = strPC
Set rs = Nothing
Set conn = Nothing
Set Root = Nothing
Set Domain = Nothing
End Function
Modul:
Private Sub AD_auslesen()
Dim strA() As String
Dim i As Long
Dim i2 As Long 'Zähler Blatt ADtest
strA = AllComputers
i2 = 1
If Not strA(0) = "" Then
For i = 0 To UBound(strA)
Sheets("ADtest").Select
Cells(i2, 1) = strA(i)
i2 = i2 + 1
Next
End If
End Sub
[Edit Biber] Codeformatierung nachgezogen [/Edit]
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 148023
Url: https://administrator.de/forum/vba-excel-computername-und-bezeichnungdescription-aus-active-directory-auslesen-win2003-domaene-148023.html
Ausgedruckt am: 30.04.2025 um 23:04 Uhr
10 Kommentare
Neuester Kommentar
Hallo tranceman84 und willkommen im Forum!
Es sollte doch genügen, die Zeile 34 auf
zu ergänzen, sodass in der Schleife ab Zeile 47 dann auch etwas in der Art von
(oder wie immer Du die Beschreibung speichern willst) möglich wird ...
Grüße
bastla
Es sollte doch genügen, die Zeile 34 auf
strAttr = "name,description"
strPCDescr(nElement) = rs("description")
Grüße
bastla

Schau dir mal Scriptomatic an: http://www.microsoft.com/downloads/details.aspx?familyid=09dfc342-648b- ...

Hallo tranceman84!
Die Zeile 47 -60 könnte man auch durch diese Codezeilen ersetzen:
Gruß Dieter
[edit] Kommentar geändert [/edit]
Die Zeile 47 -60 könnte man auch durch diese Codezeilen ersetzen:
ReDim strPC(1 To rs.RecordCount) As String
Do Until rs.EOF
strPC(rs.AbsolutePosition) = rs("name")
rs.MoveNext
Loop
Gruß Dieter
[edit] Kommentar geändert [/edit]
Hallo tranceman84!
Scheint etwas knifflig zu sein - versuch es damit:
(ob es hier so geklappt hat, ist mangels Feedback nicht eindeutig festzustellen).
Grüße
bastla
Scheint etwas knifflig zu sein - versuch es damit:
Desc = rs("description")
If Not IsNull(Desc) Then strPCDescr(nElement) = Desc(0)
Grüße
bastla

Hallo tranceman84!
Gruß Dieter
Zitat von @tranceman84:
Aber das hat eigentlich nichts mit dem Problem "Bezeichnung auslesen" zu tun oder?
Nö, dass hat es sicherlich nicht. Ein Server steht mir nicht zur Verfügung, insofern kann ich zu dem eigentlichen Problem leider nix beitragen.Aber das hat eigentlich nichts mit dem Problem "Bezeichnung auslesen" zu tun oder?
Gruß Dieter