Pre-Requisites:
1) Excel should be installed on the machine where this script would be executed
2) All the users in active directory should be dumped to " C:\scripts\Ad stale cleanup project\month1day1\StaleUsers.txt " or modify the source / destination path.
-----------------------------------------------------------
-----------------------------------------------------------
On Error Resume next
Dim aUser,StrUser
Dim objExec,DistName,objUser,objLogon,objtxtFSO,strlog,objBB,BBValue,strlog1,objtxtFile1,objtxtFSO1
Dim objRootDSE,strDomain,objCommand,objRecordSet,objConnection ,CoMN
Const ADS_SCOPE_SUBTREE = 2
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Fso = CreateObject("Scripting.FileSystemObject")
'Create a txt file for stale computers
Dim objtxtFile
strlog= "C:\scripts\Ad stale cleanup project\month1day1\StaleUsers.txt"
Set objtxtFSO=CreateObject("Scripting.Filesystemobject")
Set objtxtFile=objtxtFSO.CreateTextFile(strlog,True)
If FSO.FileExists("C:\scripts\Ad stale cleanup project\month1day1\CustomAttr.xlsx") Then
fso.DeleteFile "C:\scripts\Ad stale cleanup project\month1day1\CustomAttr.xlsx"
End If
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Worksheets(1)
intRow = 2
objExcel.Cells(1, 1).Value = "Display Name"
objExcel.Cells(1, 2).Value = "extensionAttribute1"
objExcel.Cells(1, 3).Value = "extensionAttribute2"
objExcel.Cells(1, 4).Value = "extensionAttribute3"
objExcel.Cells(1, 5).Value = "extensionAttribute4"
objExcel.Cells(1, 6).Value = "extensionAttribute5"
objExcel.Cells(1, 7).Value = "extensionAttribute6"
objExcel.Cells(1, 8).Value = "extensionAttribute7"
objExcel.Cells(1, 9).Value = "extensionAttribute8"
objExcel.Cells(1, 10).Value = "extensionAttribute9"
objExcel.Cells(1, 11).Value = "extensionAttribute10"
objExcel.Cells(1, 12).Value = "extensionAttribute11"
objExcel.Cells(1, 13).Value = "extensionAttribute12"
objExcel.Cells(1, 14).Value = "extensionAttribute13"
objExcel.Cells(1, 15).Value = "extensionAttribute14"
objExcel.Cells(1, 16).Value = "extensionAttribute15"
objExcel.Cells(1, 2).Interior.ColorIndex = 27
objExcel.Cells(1, 5).Interior.ColorIndex = 27
objExcel.Cells(1, 6).Interior.ColorIndex = 27
objExcel.Cells(1, 1).Interior.ColorIndex = 27
objExcel.Cells(1, 7).Interior.ColorIndex = 27
objExcel.Cells(1, 8).Interior.ColorIndex = 27
objExcel.Cells(1, 3).Interior.ColorIndex = 27
objExcel.Cells(1, 4).Interior.ColorIndex = 27
objExcel.Cells(1, 9).Interior.ColorIndex = 27
objExcel.Cells(1, 10).Interior.ColorIndex = 27
objExcel.Cells(1, 11).Interior.ColorIndex = 27
objExcel.Cells(1, 12).Interior.ColorIndex = 27
objExcel.Cells(1, 13).Interior.ColorIndex = 27
objExcel.Cells(1, 14).Interior.ColorIndex = 27
objExcel.Cells(1, 15).Interior.ColorIndex = 27
objExcel.Cells(1, 16).Interior.ColorIndex = 27
objExcel.Cells(1, 2).font.bold = True
objExcel.Cells(1, 5).font.bold = True
objExcel.Cells(1, 6).font.bold = True
objExcel.Cells(1, 1).font.bold = True
objExcel.Cells(1, 7).font.bold = True
objExcel.Cells(1, 8).font.bold = True
objExcel.Cells(1, 3).font.bold = True
objExcel.Cells(1, 4).font.bold = True
objExcel.Cells(1, 9).font.bold = True
objExcel.Cells(1, 10).font.bold = True
objExcel.Cells(1, 11).font.bold = True
objExcel.Cells(1, 12).font.bold = True
objExcel.Cells(1, 13).font.bold = True
objExcel.Cells(1, 14).font.bold = True
objExcel.Cells(1, 15).font.bold = True
objExcel.Cells(1, 16).font.bold = True
objexcel.Selection.Autofilter
Set oFS = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("WScript.Shell")
InputFile = "C:\scripts\Ad stale cleanup project\month1day1\AllUsers.txt"
Set f = oFS.OpenTextFile(InputFile)
StrUser = f.ReadAll
f.Close
arrUsers = Split(StrUser,vbCrLf)
For Each aUser in arrUsers
Set objRootDSE = GetObject("LDAP://RootDSE")
strDomain = objRootDSE.Get("DefaultNamingContext")
' Set ADO connection
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
' Set ADO command
Set objCommand = CreateObject("ADODB.Command")
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://" & strDomain & "' WHERE objectCategory='user' AND samAccountName = '" & auser & "'"
' Set recordset to hold the query result
Set objRecordSet = objCommand.Execute
DistName = objRecordSet.Fields("distinguishedName").Value
If DistName <> "" then
'If distinguished Name is a null value ( null value for deleted users ) then such users are not processed.
set objUser = GetObject("LDAP://" & DistName)
set objLogon = objUser.Get("lastLogontimestamp")
ext1 = objUser.Get("extensionAttribute1")
ext2 = objUser.Get("extensionAttribute2")
ext3 = objUser.Get("extensionAttribute3")
ext4 = objUser.Get("extensionAttribute4")
ext5 = objUser.Get("extensionAttribute5")
ext6 = objUser.Get("extensionAttribute6")
ext7 = objUser.Get("extensionAttribute7")
ext8 = objUser.Get("extensionAttribute8")
ext9 = objUser.Get("extensionAttribute9")
ext10 = objUser.Get("extensionAttribute10")
ext11 = objUser.Get("extensionAttribute11")
ext12 = objUser.Get("extensionAttribute12")
ext13 = objUser.Get("extensionAttribute13")
ext14 = objUser.Get("extensionAttribute14")
ext15 = objUser.Get("extensionAttribute15")
CoMN = objUser.Get("cn")
objExcel.Cells(intRow, 2).Value = ext1
objExcel.Cells(intRow, 5).Value = ext4
objExcel.Cells(intRow, 6).Value = ext5
objExcel.Cells(intRow, 1).Value = CoMN
objExcel.Cells(intRow, 7).Value = ext6
objExcel.Cells(intRow, 8).Value = ext7
objExcel.Cells(intRow, 3).Value = ext2
objExcel.Cells(intRow, 4).Value = ext3
objExcel.Cells(intRow, 9).Value = ext8
objExcel.Cells(intRow, 10).Value = ext9
objExcel.Cells(intRow, 11).Value = ext10
objExcel.Cells(intRow, 12).Value = ext11
objExcel.Cells(intRow, 13).Value = ext12
objExcel.Cells(intRow, 14).Value = ext13
objExcel.Cells(intRow, 15).Value = ext14
objExcel.Cells(intRow, 16).Value = ext15
intRow = intRow + 1
End If
objBB = Null
objBBC = Null
div = Null
aUser = Null
Country = Null
DistName = Null
StaleDate = Null
CoMN = Null
Next
objexcel.Cells.EntireColumn.AutoFit
objexcel.Cells.EntireRow.AutoFit
objWorkbook.SaveAs "C:\scripts\Ad stale cleanup project\month1day1\CustomAttr.xlsx"
objExcel.Quit
MsgBox "Script Executed. Please check the output."