Active Directory Growth Tracker: A Script to Count Objects

LISTING 1: ADacctCountsToXL.vbs

 

On Error Resume Next

******* Begin Callout A *******

DBPath = "C:\scripts\ADacctTrack\"

******* End Callout A *******

AccountCountDB = DBPath & "ADAccountCounts.xml"

Set fso = CreateObject("Scripting.FileSystemObject")	

If fso.FileExists(AccountCountDB) Then
 Set DRS = CreateObject("ADODB.Recordset")
 DRS.Open AccountCountDB

******* Begin Callout B *******

DRS.Sort = "RunDate ASC"

******* End Callout B *******

Else
 Set fso = Nothing
 strMessage = AccountCountDB & " Not Found...Terminating Script!"
 strScriptName = "AD Account Counts"
 CreateObject("WScript.Shell").Popup strMessage,10,strScriptName,vbInformation
 Wscript.Quit
End If

Set XL = CreateObject("Excel.Application")
XL.Workbooks.Add
XL.Sheets.Add.name = "AccountCounts"
XL.Sheets("AccountCounts").Select
XL.Visible = TRUE

******* Begin Callout C *******

Set FldRef = CreateObject("Scripting.Dictionary")

Set objFields = DRS.Fields
'*** Use number of fields to set array dimension
'*** reduce number by 2.  One to account for zero based array
'*** and another to omit 'RunDate' field
FldDim = objFields.count - 2
 
Dim DRSFields()
Redim Preserve DRSFields(flddim)
incr = 0
For Each objField In objFields
'*** This block of code sets up a Field/Row association
'*** A specific field will have a specific Row in the Excel spreadsheet
'*** 'Rundate' is the first field in the database and is not
'*** used as a Row so it is ignored.  Fields start on Row 2
'*** Rundate dates start in Col 2.  This format is good for charts
 If Lcase(objField.Name)  "rundate" Then
  FldRef.Add objField.Name,incr+2     'Field name and Row assignment
  DRSFields(incr) = objField.Name
  incr = incr + 1
 End If
Next

******* End Callout C *******

******* Begin Callout D *******

'*** Fill Column A with Fieldnames
For i = 0 to Ubound(DRSFields)
 XL.Cells(i+2,1).Value = DRSFields(i) 'start at row 2
Next

******* End Callout D *******

Col = 2

******* Begin Callout E *******

DRS.MoveFirst
Do while Not DRS.EOF
 StoreDate = DRS.Fields.Item("RunDate")
 XL.Cells(1,Col).Value = Cstr(DRS.Fields.Item("RunDate"))
 Do While StoreDate = DRS.Fields.Item("RunDate")
  For i = 0 to Ubound(DRSFields)
   If FldRef.Exists(DRSFields(i)) Then
    '*** find associated Field/Row
    Row = FldRef.item(DRSFields(i))
    XL.Cells(Row,Col).Value = Cdbl(DRS.Fields.Item(DRSFields(i)))
   End If
  Next
  DRS.MoveNext
  If DRS.EOF Then
   Exit Do
  End If
 Loop
 Col = Col + 1  'put next rundate in next column
Loop

******* End Callout E *******

DRS.Close
Set fso = nothing
Set DRS = nothing
XL.Cells.EntireColumn.AutoFit
XL.Range("A1").Select

strMessage = "Done"
strScriptName = "AD Account Counts"
CreateObject("WScript.Shell").Popup strMessage,15,strScriptName,vbInformation