Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

VBA - Excel - Computername und Bezeichnung(description) aus Active Directory auslesen. Win2003 Domäne

Frage Entwicklung VB for Applications

Mitglied: tranceman84

tranceman84 (Level 1) - Jetzt verbinden

30.07.2010, aktualisiert 18:23 Uhr, 10050 Aufrufe, 10 Kommentare

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:
01.
Public Function AllComputers() As String() 
02.
  Dim conn As New Connection 
03.
  Dim rs As Recordset 
04.
  
05.
  Dim Root As IADs 
06.
  Dim Domain As IADs 
07.
  
08.
  Dim strBase As String 
09.
  Dim strFilter As String 
10.
  Dim strDomain As String 
11.
  
12.
  Dim strAttr As String 
13.
  Dim strDepth As String 
14.
  Dim strQuery As String 
15.
  Dim strPC() As String 
16.
  Dim nElement As Integer 
17.
  
18.
  On Error GoTo ErrHandler 
19.
  
20.
  ReDim strPC(0) As String 
21.
  
22.
  ' Pfad der gegenwärtigen Domäne (LDAP) einholen 
23.
  Set Root = GetObject("LDAP://rootDSE") 
24.
  strDomain = Root.Get("defaultNamingContext") 
25.
  Set Domain = GetObject("LDAP://" & strDomain) 
26.
  
27.
  ' LDAP Base DN setzen 
28.
  strBase = "<" & Domain.ADsPath & ">" 
29.
  
30.
  ' Filter auf die Kategorie Computer setzen 
31.
  strFilter = "(&(objectCategory=Computer))" 
32.
  
33.
  ' Attribut setzen 
34.
  strAttr = "name" 
35.
  ' Suchtiefe setzen 
36.
  strDepth = "subTree" 
37.
  
38.
  ' Abfrage zusammen setzen 
39.
  strQuery = strBase & ";" & strFilter & ";" & strAttr & ";" & ";" & strDepth 
40.
  Debug.Print strQuery 
41.
  ' Verbindung öffnen 
42.
  conn.Open "Data Source=Active Directory Provider;Provider=ADsDSOObject" 
43.
  
44.
  ' Query ausführen 
45.
  Set rs = conn.Execute(strQuery) 
46.
 
47.
  Do While Not rs.EOF 
48.
    If strPC(0) = "" Then 
49.
      nElement = 0 
50.
    Else 
51.
      nElement = nElement + 1 
52.
    End If 
53.
 
54.
    ' das Array Redimensionieren 
55.
    ReDim Preserve strPC(nElement) As String 
56.
 
57.
    ' Den Computernamen in das Array schreiben 
58.
    strPC(nElement) = rs("name") 
59.
    rs.MoveNext 
60.
  Loop 
61.
  
62.
  ' Das StringArray zurückgeben 
63.
  AllComputers = strPC 
64.
  
65.
  If rs.State <> 0 Then rs.Close 
66.
  If conn.State <> 0 Then conn.Close 
67.
  
68.
' Error Handling 
69.
ErrHandler: 
70.
  On Error Resume Next 
71.
  AllComputers = strPC 
72.
  Set rs = Nothing 
73.
  Set conn = Nothing 
74.
  Set Root = Nothing 
75.
  Set Domain = Nothing 
76.
End Function 
77.
 
78.
Modul: 
79.
 
80.
Private Sub AD_auslesen() 
81.
  Dim strA() As String 
82.
  Dim i As Long 
83.
  Dim i2 As Long 'Zähler Blatt ADtest 
84.
      
85.
  strA = AllComputers 
86.
  i2 = 1 
87.
     
88.
  If Not strA(0) = "" Then 
89.
    For i = 0 To UBound(strA) 
90.
 
91.
            Sheets("ADtest").Select 
92.
            Cells(i2, 1) = strA(i) 
93.
            i2 = i2 + 1 
94.
 
95.
    Next 
96.
  End If 
97.
End Sub
[Edit Biber] Codeformatierung nachgezogen [/Edit]
Mitglied: bastla
30.07.2010 um 18:51 Uhr
Hallo tranceman84 und willkommen im Forum!

Es sollte doch genügen, die Zeile 34 auf
 strAttr = "name,description"
zu ergänzen, sodass in der Schleife ab Zeile 47 dann auch etwas in der Art von
strPCDescr(nElement) = rs("description")
(oder wie immer Du die Beschreibung speichern willst) möglich wird ...

Grüße
bastla
Bitte warten ..
Mitglied: tranceman84
31.07.2010 um 06:32 Uhr
Hallo Bastla,

habe versucht das so einzubinden.
Leider bekomme ich die Variable strPCDescr nicht gefüllt.

Entweder bekommt die Schleife den Wert "" zurück oder es geht direkt in den Error Handler des Programms.

Mit freundlichen Grüßen
Tranceman84
Bitte warten ..
Mitglied: 76109
31.07.2010 um 09:25 Uhr
Hallo tranceman84!

Die Zeile 47 -60 könnte man auch durch diese Codezeilen ersetzen:
01.
ReDim strPC(1 To rs.RecordCount) As String 
02.
 
03.
Do Until rs.EOF 
04.
    strPC(rs.AbsolutePosition) = rs("name") 
05.
    rs.MoveNext 
06.
Loop
Gruß Dieter

[edit] Kommentar geändert [/edit]
Bitte warten ..
Mitglied: bastla
31.07.2010 um 10:11 Uhr
Hallo tranceman84!

Scheint etwas knifflig zu sein - versuch es damit:
01.
Desc = rs("description") 
02.
If Not IsNull(Desc) Then strPCDescr(nElement) = Desc(0)
(ob es hier so geklappt hat, ist mangels Feedback nicht eindeutig festzustellen).

Grüße
bastla
Bitte warten ..
Mitglied: tranceman84
02.08.2010 um 07:43 Uhr
Vielen Dank für den Tipp.
Aber das hat eigentlich nichts mit dem Problem "Bezeichnung auslesen" zu tun oder?
Bitte warten ..
Mitglied: tranceman84
02.08.2010 um 07:47 Uhr
Hi Bastla,

leider wieder ohne Erfolg.

Selbst das Programm, wo du diesen Lösungsansatz gefunden hast ist nicht lauffähig.
Habe ich gerade versucht zu testen.

Ich bin jetzt kein Experte in diesem Gebiet, eher im Gegenteil.
Ich habe fast den Eindruck, dass man die Bezeichnung über die Deklaration "description" ein der englischen Version von Win2003 Server so auslesen kann.
Wir haben die deutsche Variante installiert. Kann es sein, dass die Deklaration eventuell dann anders heisst?

Mit freundlichen Grüßen
Tranceman84
Bitte warten ..
Mitglied: bastla
02.08.2010 um 08:14 Uhr
Hallo tranceman84!
Kann es sein, dass die Deklaration eventuell dann anders heisst?
Das zumindest wäre als Fehlerquelle auszuschließen - ansonsten fällt mir aber auch nix mehr ein (bei mir hat der Ansatz übrigens - als VBScript kurz am Server getestet - funktioniert) ...

Grüße
bastla
Bitte warten ..
Mitglied: 76109
02.08.2010 um 08:41 Uhr
Hallo tranceman84!

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.

Gruß Dieter
Bitte warten ..
Mitglied: tranceman84
02.08.2010 um 08:54 Uhr
Hallo an alle, das Problem habe ich lösen können.
Ich denke es ist nicht die optimalste Lösung, aber auf jedenfall funktioniert sie

Wenn mein Sub "AD_auslesen" gestartet wird, springt das Programm in die Function "AllComputers".
In der Function werden alle Computernamen der Domäne augelesen, in der der Benutzer angemeldet ist, der das Programm startet.
Das Ergbenis der Function (die komplette Computerübersicht) wird dann an das Sub "AD_auslesen" zurückgegeben, welches dann die Computernamen in Excel schreibt.
Danach wird das Sub "BezeichnungADauslsesen" gestartet, in dem die Eigentlichen Computerbezeichnungen (descriptions) in Verbindung mit den vorher gelesenen Computernamen ausgelesen und nach Excel zurückgegeben werden.

Den Quellcode für das Programm "BezeichnungADauslsesen" habe ich unter folgendem Link gefunden:
http://www.mcseboard.de/windows-server-forum-78/computer-beschreibung-a ...

An dieser Stelle möchte ich mich trotzdem nochmal bei allen beteiligten für die schnelle Hilfe bedanken.

Mit freundlichen Grüßen
Tranceman84

Hier nochmal der komplett lauffähige Code:
01.
Sub AD_auslesen() 
02.
'Auslsesen der Computernamen der AD 
03.
   
04.
  Dim strA() As String 
05.
  Dim i As Long 
06.
  Dim i2 As Long 'Zähler Blatt ADtest 
07.
      
08.
  strA = AllComputers 
09.
  i2 = 1 
10.
     
11.
  If Not strA(0) = "" Then 
12.
    For i = 0 To UBound(strA) 
13.
        For i3 = 4 To Sheets("Ausnahmen").UsedRange.Rows.Count 
14.
            Sheets("Ausnahmen").Select 
15.
            If strA(i) = Cells(i3, 1) Then GoTo 10 
16.
        Next i3 
17.
         
18.
        Sheets("ADtest").Select 
19.
        Cells(i2, 1) = strA(i) 
20.
        i2 = i2 + 1 
21.
10: 
22.
    Next 
23.
  End If 
24.
End Sub 
25.
 
26.
========================================================== 
27.
 
28.
Public Function AllComputers() As String() 
29.
  Dim conn As New Connection 
30.
  Dim rs As Recordset 
31.
  
32.
  Dim Root As IADs 
33.
  Dim Domain As IADs 
34.
  
35.
  Dim strBase As String 
36.
  Dim strFilter As String 
37.
  Dim strDomain As String 
38.
  
39.
  Dim strAttr As String 
40.
  Dim strDepth As String 
41.
  Dim strQuery As String 
42.
  Dim strPC() As String 
43.
  Dim nElement As Integer 
44.
  
45.
  On Error GoTo ErrHandler 
46.
  
47.
  ReDim strPC(0) As String 
48.
  
49.
  ' Pfad der gegenwärtigen Domäne (LDAP) einholen 
50.
  Set Root = GetObject("LDAP://rootDSE") 
51.
  strDomain = Root.Get("defaultNamingContext") 
52.
  Set Domain = GetObject("LDAP://" & strDomain) 
53.
  
54.
  ' LDAP Base DN setzen 
55.
  strBase = "<" & Domain.ADsPath & ">" 
56.
  
57.
  ' Filter auf die Kategorie Computer setzen 
58.
  strFilter = "(&(objectCategory=Computer))" 
59.
  
60.
  ' Attribut setzen 
61.
  strAttr = "name" 
62.
  
63.
  ' Suchtiefe setzen 
64.
  strDepth = "subTree" 
65.
  
66.
  ' Abfrage zusammen setzen 
67.
  strQuery = strBase & ";" & strFilter & ";" & strAttr & ";" & strDepth 
68.
  
69.
  ' Verbindung öffnen 
70.
  conn.Open "Data Source=Active Directory Provider;Provider=ADsDSOObject" 
71.
  
72.
  ' Query ausführen 
73.
  Set rs = conn.Execute(strQuery) 
74.
  
75.
  Do While Not rs.EOF 
76.
    If strPC(0) = "" Then 
77.
      nElement = 0 
78.
    Else 
79.
      nElement = nElement + 1 
80.
    End If 
81.
  
82.
    ' das Array Redimensionieren 
83.
    ReDim Preserve strPC(nElement) As String 
84.
  
85.
    ' Den Computernamen in das Array schreiben 
86.
    strPC(nElement) = rs("name") 
87.
    rs.MoveNext 
88.
  Loop 
89.
  
90.
  ' Das StringArray zurückgeben 
91.
  AllComputers = strPC 
92.
  
93.
  If rs.State <> 0 Then rs.Close 
94.
  If conn.State <> 0 Then conn.Close 
95.
  
96.
' Error Handling 
97.
ErrHandler: 
98.
  On Error Resume Next 
99.
  AllComputers = strPC 
100.
  Set rs = Nothing 
101.
  Set conn = Nothing 
102.
  Set Root = Nothing 
103.
  Set Domain = Nothing 
104.
End Function 
105.
 
106.
========================================================== 
107.
 
108.
Sub BezeichnungADauslsesen() 
109.
Dim strCN As String 'Computername 
110.
 
111.
On Error Resume Next 
112.
 
113.
Dim WshShell, Hostname 
114.
 
115.
For i = 1 To Sheets("ADtest").UsedRange.Rows.Count 
116.
    Sheets("ADtest").Select 
117.
    strCN = Cells(i, 1) 
118.
     
119.
    Const ADS_SCOPE_SUBTREE = 2 
120.
    Set objConnection = CreateObject("ADODB.Connection") 
121.
    Set objCommand = CreateObject("ADODB.Command") 
122.
    objConnection.Provider = "ADsDSOObject" 
123.
    objConnection.Open "Active Directory Provider" 
124.
    Set objCommand.ActiveConnection = objConnection 
125.
    objCommand.Properties("Page Size") = 1000 
126.
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
127.
    objCommand.CommandText = _ 
128.
       "SELECT ADsPath FROM 'LDAP://DC=satrup,DC=zmg,DC=local' WHERE objectCategory='computer' AND Name='" & strCN & "'" 
129.
    Set objRecordSet = objCommand.Execute 
130.
    objRecordSet.MoveFirst 
131.
    strADsPath = objRecordSet.Fields("ADsPath").Value 
132.
     
133.
    Set objComputer = GetObject(strADsPath) 
134.
     
135.
    objproperty = objComputer.Get("Description") 
136.
     
137.
    Cells(i, 2) = objproperty 
138.
         
139.
Next i 
140.
 
141.
End Sub
Bitte warten ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
VB for Applications
gelöst VBA: Wert von einer Website (pdf-Dokument) auslesen und in Excel kopieren (16)

Frage von Stern123 zum Thema VB for Applications ...

Windows Server
gelöst Active Directory File Extension - Associated Program (11)

Frage von adm2015 zum Thema Windows Server ...

Windows 8
gelöst Active Directory Default User.v2 Profile - Windows 8.1 Apps Error (4)

Frage von adm2015 zum Thema Windows 8 ...

Windows Server
Active Directory sinnvoll für kleine Firma (15)

Frage von WolfPeano zum Thema Windows Server ...

Heiß diskutierte Inhalte
Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...

Exchange Server
DNS Einstellung - zwei feste IPs für Mailserver (15)

Frage von ivan0s zum Thema Exchange Server ...