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