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
   | 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 | 
Partager