Exportation données Active Directory

Version imprimable

Bonjour,

Je viens de tomber sur cette page : http://www.developpez.net/forums/d82...ive-directory/

non actualisée depuis 2005. Comme ce programme m'intéressait grandement, je l'ai corrigé et testé sous VB.net 2003

Je poste ci-dessous le code corrigé (à insérer dans une "Sub") pour tous ceux qui souhaitent l'utiliser :

Merci à l'auteur pour ce code presque abouti :D

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
 
 
        Dim accountcontrol
        Const ADS_SCOPE_SUBTREE = 2
        ' Dim objRootDSE
 
 
        ' Création du fichier Excel
 
        Dim objExcel = CreateObject("Excel.Application")
        Dim fsoObject = CreateObject("Scripting.FileSystemObject")
 
        objExcel.Visible = True
        objExcel.Workbooks.Add()
 
        objExcel.Cells(1, 1).Value = "Liste des Comptes " & " le " & FormatDateTime(Now, vbLongDate)
        objExcel.Cells(1, 1).Font.Bold = True
        objExcel.Cells(1, 1).Font.Size = 10
        objExcel.Cells(1, 1).Font.ColorIndex = 3
 
 
        ' Ajout des titres de colonnes
 
        objExcel.Cells(2, 2).Value = "Last name"
        objExcel.Cells(2, 2).Font.ColorIndex = 5
        objExcel.Cells(2, 3).Value = "First name"
        objExcel.Cells(2, 3).Font.ColorIndex = 5
        objExcel.Cells(2, 4).Value = "samAccountName"
        objExcel.Cells(2, 4).Font.ColorIndex = 5
        objExcel.Cells(2, 5).Value = "Department"
        objExcel.Cells(2, 5).Font.ColorIndex = 5
        objExcel.Cells(2, 6).Value = "Phone number"
        objExcel.Cells(2, 6).Font.ColorIndex = 5
        objExcel.Cells(2, 7).Value = "Mail"
        objExcel.Cells(2, 7).Font.ColorIndex = 5
        objExcel.Cells(2, 8).Value = "userPrincipalName"
        objExcel.Cells(2, 8).Font.ColorIndex = 5
        objExcel.Cells(2, 9).Value = "distinguishedName"
        objExcel.Cells(2, 9).Font.ColorIndex = 5
        objExcel.Cells(2, 10).Value = "homeDirectory"
        objExcel.Cells(2, 10).Font.ColorIndex = 5
        objExcel.Cells(2, 11).Value = "homeDrive"
        objExcel.Cells(2, 11).Font.ColorIndex = 5
        objExcel.Cells(2, 12).Value = "canonicalName"
        objExcel.Cells(2, 12).Font.ColorIndex = 5
        objExcel.Cells(2, 13).Value = "scriptPath"
        objExcel.Cells(2, 13).Font.ColorIndex = 5
        objExcel.Cells(2, 14).Value = "userAccountControl"
        objExcel.Cells(2, 14).Font.ColorIndex = 5
 
 
        ' Connexion Active directory et selection des données
 
        Dim objRootDSE, strDNSDomain, objCommand, objConnection
        Dim strBase, strFilter, strAttributes, strQuery ' objRecordSet
 
        ' Determine DNS domain name.
        objRootDSE = GetObject("LDAP://RootDSE")
        strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
        ' Use ADO to search Active Directory.
        objCommand = CreateObject("ADODB.Command")
        objConnection = CreateObject("ADODB.Connection")
        objConnection.Provider = "ADsDSOObject"
        objConnection.Open("Active Directory Provider")
        objCommand.ActiveConnection = objConnection
        strBase = "<LDAP://" & strDNSDomain & ">"
 
        objCommand.Properties("Page Size") = 100
        objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
        objCommand.CommandText = _
"SELECT givenName, SN, samAccountName, department, telephoneNumber, mail, userPrincipalName, distinguishedName, homeDirectory, homeDrive, canonicalName, scriptPath, userAccountControl" _
& " FROM " & "'LDAP://" & strDNSDomain & "' WHERE " _
           & "objectCategory='person' AND objectClass='user' ORDER BY samAccountName"
 
        Dim objRecordSet = objCommand.Execute
 
        objRecordSet.MoveFirst()
        Dim x = 3
 
        ' Export des données vers Excel
 
        Do Until objRecordSet.EOF
            objExcel.Cells(x, 2).Value = _
                objRecordSet.Fields("SN").Value
            objExcel.Cells(x, 3).Value = _
                objRecordSet.Fields("givenName").Value
            objExcel.Cells(x, 4).Value = _
                objRecordSet.Fields("samAccountName").Value
            objExcel.Cells(x, 5).Value = _
                objRecordSet.Fields("department").Value
            objExcel.Cells(x, 6).Value = _
                objRecordSet.Fields("telephoneNumber").Value
            objExcel.Cells(x, 7).Value = _
                objRecordSet.Fields("mail").Value
            objExcel.Cells(x, 8).Value = _
                objRecordSet.Fields("userPrincipalName").Value
            objExcel.Cells(x, 9).Value = _
                objRecordSet.Fields("distinguishedName").Value
            objExcel.Cells(x, 10).Value = _
                objRecordSet.Fields("homeDirectory").Value
            objExcel.Cells(x, 11).Value = _
                objRecordSet.Fields("homeDrive").Value
            objExcel.Cells(x, 12).Value = _
                objRecordSet.Fields("canonicalName").Value
            objExcel.Cells(x, 13).Value = _
                objRecordSet.Fields("scriptPath").Value
 
 
            ' Check du User Account Control pour déterminer si les comptes sont Enabled
            ' ou Disabled
 
            accountcontrol = objRecordSet.Fields("userAccountControl").Value
 
            If accountcontrol And 2 Then
                objExcel.Cells(x, 14).Value = "Disabled"
            Else : objExcel.Cells(x, 14).Value = "enabled"
            End If
 
            x = x + 1
            objRecordSet.MoveNext()
        Loop
 
 
        ' Autofit des cellules Excel
 
        objExcel.Columns("B:N").Select()
        objExcel.Selection.Columns.AutoFit()
        objExcel.Range("A1").Select()
 
        ' Clean up.
        objConnection.Close()
        objRootDSE = Nothing
        objCommand = Nothing
        objConnection = Nothing
        objRecordSet = Nothing
 
 
        ' Fin de Script

Cool, ça peut être super utile à l'occase, merci

Je mets le code (juste modifié, pas remit au propre) pour que ça fonctionne directement en VBS :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
 
Dim accountcontrol
Const ADS_SCOPE_SUBTREE = 2
' Dim objRootDSE
 
 
' Création du fichier Excel
 
Set objExcel = CreateObject("Excel.Application")
Set fsoObject = CreateObject("Scripting.FileSystemObject")
 
objExcel.Visible = True
objExcel.Workbooks.Add()
 
objExcel.Cells(1, 1).Value = "Liste des Comptes " & " le " & FormatDateTime(Now, vbLongDate)
objExcel.Cells(1, 1).Font.Bold = True
objExcel.Cells(1, 1).Font.Size = 10
objExcel.Cells(1, 1).Font.ColorIndex = 3
 
 
' Ajout des titres de colonnes
 
objExcel.Cells(2, 2).Value = "Last name"
objExcel.Cells(2, 2).Font.ColorIndex = 5
objExcel.Cells(2, 3).Value = "First name"
objExcel.Cells(2, 3).Font.ColorIndex = 5
objExcel.Cells(2, 4).Value = "samAccountName"
objExcel.Cells(2, 4).Font.ColorIndex = 5
objExcel.Cells(2, 5).Value = "Department"
objExcel.Cells(2, 5).Font.ColorIndex = 5
objExcel.Cells(2, 6).Value = "Phone number"
objExcel.Cells(2, 6).Font.ColorIndex = 5
objExcel.Cells(2, 7).Value = "Mail"
objExcel.Cells(2, 7).Font.ColorIndex = 5
objExcel.Cells(2, 8).Value = "userPrincipalName"
objExcel.Cells(2, 8).Font.ColorIndex = 5
objExcel.Cells(2, 9).Value = "distinguishedName"
objExcel.Cells(2, 9).Font.ColorIndex = 5
objExcel.Cells(2, 10).Value = "homeDirectory"
objExcel.Cells(2, 10).Font.ColorIndex = 5
objExcel.Cells(2, 11).Value = "homeDrive"
objExcel.Cells(2, 11).Font.ColorIndex = 5
objExcel.Cells(2, 12).Value = "canonicalName"
objExcel.Cells(2, 12).Font.ColorIndex = 5
objExcel.Cells(2, 13).Value = "scriptPath"
objExcel.Cells(2, 13).Font.ColorIndex = 5
objExcel.Cells(2, 14).Value = "userAccountControl"
objExcel.Cells(2, 14).Font.ColorIndex = 5
 
 
' Connexion Active directory et selection des données
 
Dim objRootDSE, strDNSDomain, objCommand, objConnection
Dim strBase, strFilter, strAttributes, strQuery ' objRecordSet
 
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
' Use ADO to search Active Directory.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open("Active Directory Provider")
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strDNSDomain & ">"
 
objCommand.Properties("Page Size") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"SELECT givenName, SN, samAccountName, department, telephoneNumber, mail, userPrincipalName, distinguishedName, homeDirectory, homeDrive, canonicalName, scriptPath, userAccountControl" _
& " FROM " & "'LDAP://" & strDNSDomain & "' WHERE " _
   & "objectCategory='person' AND objectClass='user' ORDER BY samAccountName"
 
Set objRecordSet = objCommand.Execute
 
objRecordSet.MoveFirst()
x = 3
 
' Export des données vers Excel
 
Do Until objRecordSet.EOF
	objExcel.Cells(x, 2).Value = _
		objRecordSet.Fields("SN").Value
	objExcel.Cells(x, 3).Value = _
		objRecordSet.Fields("givenName").Value
	objExcel.Cells(x, 4).Value = _
		objRecordSet.Fields("samAccountName").Value
	objExcel.Cells(x, 5).Value = _
		objRecordSet.Fields("department").Value
	objExcel.Cells(x, 6).Value = _
		objRecordSet.Fields("telephoneNumber").Value
	objExcel.Cells(x, 7).Value = _
		objRecordSet.Fields("mail").Value
	objExcel.Cells(x, 8).Value = _
		objRecordSet.Fields("userPrincipalName").Value
	objExcel.Cells(x, 9).Value = _
		objRecordSet.Fields("distinguishedName").Value
	objExcel.Cells(x, 10).Value = _
		objRecordSet.Fields("homeDirectory").Value
	objExcel.Cells(x, 11).Value = _
		objRecordSet.Fields("homeDrive").Value
	objExcel.Cells(x, 12).Value = _
		objRecordSet.Fields("canonicalName").Value
	objExcel.Cells(x, 13).Value = _
		objRecordSet.Fields("scriptPath").Value
 
 
	' Check du User Account Control pour déterminer si les comptes sont Enabled
	' ou Disabled
 
	accountcontrol = objRecordSet.Fields("userAccountControl").Value
 
	If accountcontrol And 2 Then
		objExcel.Cells(x, 14).Value = "Disabled"
	Else : objExcel.Cells(x, 14).Value = "enabled"
	End If
 
	x = x + 1
	objRecordSet.MoveNext()
Loop
 
 
' Autofit des cellules Excel
 
objExcel.Columns("B:N").Select()
objExcel.Selection.Columns.AutoFit()
objExcel.Range("A1").Select()
 
' Clean up.
objConnection.Close()
Set objRootDSE = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
Set objRecordSet = Nothing
 
 
' Fin de Script

12/11/2008, 16h28
SfJ5Rpw8

:king:

:merci: à tous les 2 (ou 3) ;)

Petite aide sur ce script

bonjour,

tout d'abord, ce script marche nickel.
mais j'aimerais cependant pouvoir l'utiliser afin d'extraire uniquement les utilisateurs de tel ou tel ou.
etant débutant je ne sais pas a quel endroit on modifie le code

merci pour votre aide!!

cordialement

Citation:

Envoyé par pitchalov

Cool, ça peut être super utile à l'occase, merci

Je mets le code (juste modifié, pas remit au propre) pour que ça fonctionne directement en VBS :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
 
Dim accountcontrol
Const ADS_SCOPE_SUBTREE = 2
' Dim objRootDSE
 
 
' Création du fichier Excel
 
Set objExcel = CreateObject("Excel.Application")
Set fsoObject = CreateObject("Scripting.FileSystemObject")
 
objExcel.Visible = True
objExcel.Workbooks.Add()
 
objExcel.Cells(1, 1).Value = "Liste des Comptes " & " le " & FormatDateTime(Now, vbLongDate)
objExcel.Cells(1, 1).Font.Bold = True
objExcel.Cells(1, 1).Font.Size = 10
objExcel.Cells(1, 1).Font.ColorIndex = 3
 
 
' Ajout des titres de colonnes
 
objExcel.Cells(2, 2).Value = "Last name"
objExcel.Cells(2, 2).Font.ColorIndex = 5
objExcel.Cells(2, 3).Value = "First name"
objExcel.Cells(2, 3).Font.ColorIndex = 5
objExcel.Cells(2, 4).Value = "samAccountName"
objExcel.Cells(2, 4).Font.ColorIndex = 5
objExcel.Cells(2, 5).Value = "Department"
objExcel.Cells(2, 5).Font.ColorIndex = 5
objExcel.Cells(2, 6).Value = "Phone number"
objExcel.Cells(2, 6).Font.ColorIndex = 5
objExcel.Cells(2, 7).Value = "Mail"
objExcel.Cells(2, 7).Font.ColorIndex = 5
objExcel.Cells(2, 8).Value = "userPrincipalName"
objExcel.Cells(2, 8).Font.ColorIndex = 5
objExcel.Cells(2, 9).Value = "distinguishedName"
objExcel.Cells(2, 9).Font.ColorIndex = 5
objExcel.Cells(2, 10).Value = "homeDirectory"
objExcel.Cells(2, 10).Font.ColorIndex = 5
objExcel.Cells(2, 11).Value = "homeDrive"
objExcel.Cells(2, 11).Font.ColorIndex = 5
objExcel.Cells(2, 12).Value = "canonicalName"
objExcel.Cells(2, 12).Font.ColorIndex = 5
objExcel.Cells(2, 13).Value = "scriptPath"
objExcel.Cells(2, 13).Font.ColorIndex = 5
objExcel.Cells(2, 14).Value = "userAccountControl"
objExcel.Cells(2, 14).Font.ColorIndex = 5
 
 
' Connexion Active directory et selection des données
 
Dim objRootDSE, strDNSDomain, objCommand, objConnection
Dim strBase, strFilter, strAttributes, strQuery ' objRecordSet
 
' Determine DNS domain name.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
 
' Use ADO to search Active Directory.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open("Active Directory Provider")
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strDNSDomain & ">"
 
objCommand.Properties("Page Size") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"SELECT givenName, SN, samAccountName, department, telephoneNumber, mail, userPrincipalName, distinguishedName, homeDirectory, homeDrive, canonicalName, scriptPath, userAccountControl" _
& " FROM " & "'LDAP://" & strDNSDomain & "' WHERE " _
   & "objectCategory='person' AND objectClass='user' ORDER BY samAccountName"
 
Set objRecordSet = objCommand.Execute
 
objRecordSet.MoveFirst()
x = 3
 
' Export des données vers Excel
 
Do Until objRecordSet.EOF
	objExcel.Cells(x, 2).Value = _
		objRecordSet.Fields("SN").Value
	objExcel.Cells(x, 3).Value = _
		objRecordSet.Fields("givenName").Value
	objExcel.Cells(x, 4).Value = _
		objRecordSet.Fields("samAccountName").Value
	objExcel.Cells(x, 5).Value = _
		objRecordSet.Fields("department").Value
	objExcel.Cells(x, 6).Value = _
		objRecordSet.Fields("telephoneNumber").Value
	objExcel.Cells(x, 7).Value = _
		objRecordSet.Fields("mail").Value
	objExcel.Cells(x, 8).Value = _
		objRecordSet.Fields("userPrincipalName").Value
	objExcel.Cells(x, 9).Value = _
		objRecordSet.Fields("distinguishedName").Value
	objExcel.Cells(x, 10).Value = _
		objRecordSet.Fields("homeDirectory").Value
	objExcel.Cells(x, 11).Value = _
		objRecordSet.Fields("homeDrive").Value
	objExcel.Cells(x, 12).Value = _
		objRecordSet.Fields("canonicalName").Value
	objExcel.Cells(x, 13).Value = _
		objRecordSet.Fields("scriptPath").Value
 
 
	' Check du User Account Control pour déterminer si les comptes sont Enabled
	' ou Disabled
 
	accountcontrol = objRecordSet.Fields("userAccountControl").Value
 
	If accountcontrol And 2 Then
		objExcel.Cells(x, 14).Value = "Disabled"
	Else : objExcel.Cells(x, 14).Value = "enabled"
	End If
 
	x = x + 1
	objRecordSet.MoveNext()
Loop
 
 
' Autofit des cellules Excel
 
objExcel.Columns("B:N").Select()
objExcel.Selection.Columns.AutoFit()
objExcel.Range("A1").Select()
 
' Clean up.
objConnection.Close()
Set objRootDSE = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
Set objRecordSet = Nothing
 
 
' Fin de Script