' LastLogonReport.vbs
' VBScript program to determine when each user in the domain last logged
' on and create an Excel Spreadsheet for users that have not logged on
' in 30 days or more.
' ----------------------------------------------------------------------
Option Explicit
On Error Resume Next
Dim objRange, objRange2, strDateDiff, strSamName
Dim objUser, strExcelPath, objExcel, objWorksheet, objGroup
Dim objRootDSE, strConfig, objConnection, objCommand, strQuery
Dim objRecordSet, objDC
Dim strDNSDomain, objShell, lngBiasKey, lngBias, k, arrstrDCs()
Dim strDN, dtmDate, objDate, lngDate, objList, strUser
Dim strBase, strFilter, strAttributes, lngHigh, lngLow
' Use a dictionary object to track latest lastLogon for each user.
Set objList = CreateObject("Scripting.Dictionary")
objList.CompareMode = vbTextCompare
' Obtain local Time Zone bias from machine registry.
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
& "TimeZoneInformation\ActiveTimeBias")
If UCase(TypeName(lngBiasKey)) = "LONG" Then
lngBias = lngBiasKey
ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
lngBias = 0
For k = 0 To UBound(lngBiasKey)
lngBias = lngBias + (lngBiasKey(k) * 256^k)
Next
End If
' Determine configuration context and DNS domain from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strConfig = objRootDSE.Get("configurationNamingContext")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
' Use ADO to search Active Directory for ObjectClass nTDSDSA.
' This will identify all Domain Controllers.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
strBase = "<LDAP://" & strConfig & ">"
strFilter = "(objectClass=nTDSDSA)"
strAttributes = "AdsPath"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 60
objCommand.Properties("Cache Results") = False
Set objRecordSet = objCommand.Execute
' Enumerate parent objects of class nTDSDSA. Save Domain Controller
' AdsPaths in dynamic array arrstrDCs.
k = 0
Do Until objRecordSet.EOF
Set objDC = _
GetObject(GetObject(objRecordSet.Fields("AdsPath")).Parent)
ReDim Preserve arrstrDCs(k)
arrstrDCs(k) = objDC.DNSHostName
k = k + 1
objRecordSet.MoveNext
Loop
' Retrieve lastLogon attribute for each user on each Domain Controller.
For k = 0 To Ubound(arrstrDCs)
strBase = "<LDAP://" & arrstrDCs(k) & "/" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user))"
strAttributes = "sAMAccountName,lastLogon" '"distinguishedName,lastLogon"
strQuery = strBase & ";" & strFilter & ";" & strAttributes _
& ";subtree"
objCommand.CommandText = strQuery
On Error Resume Next
Set objRecordSet = objCommand.Execute
If Err.Number <> 0 Then
On Error GoTo 0
'wscript.echo "Domain Controller not available: " & arrstrDCs(k)
Else
On Error GoTo 0
Do Until objRecordSet.EOF
strDN = objRecordSet.Fields("sAMAccountName") '("distinguishedName")
lngDate = objRecordSet.Fields("lastLogon")
On Error Resume Next
Set objDate = lngDate
If Err.Number <> 0 Then
On Error GoTo 0
dtmDate = #1/1/1601#
Else
On Error GoTo 0
lngHigh = objDate.HighPart
lngLow = objDate.LowPart
If lngLow < 0 Then
lngHigh = lngHigh + 1
End If
If (lngHigh = 0) And (lngLow = 0 ) Then
dtmDate = #1/1/1601#
Else
dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
+ lngLow)/600000000 - lngBias)/1440
End If
End If
If objList.Exists(strDN) Then
If dtmDate > objList(strDN) Then
objList(strDN) = dtmDate
End If
Else
objList.Add strDN, dtmDate
End If
objRecordSet.MoveNext
Loop
End If
Next
' Output latest lastLogon date for each user.
' Spreadsheet file to be created.
strExcelPath = "E:\LastlogonReport\30DayLastLogonReport.xls"
'Wscript.Echo strExcelPath
' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Excel application not found."
Wscript.Quit
End If
On Error GoTo 0
' Create a new workbook.
objExcel.Workbooks.Add
' Bind to worksheet.
Set objWorksheet = objExcel.ActiveWorkbook.Worksheets(1)
objWorksheet.Name = "LastLogon"
' Populate spreadsheet cells with user attributes.
'objWorksheet.Cells(1, 1).Value = "User Common Name"
'objWorksheet.Cells(2, 1).Value = "sAMAccountName"
'objWorksheet.Cells(3, 1).Value = "Display Name"
'objWorksheet.Cells(4, 1).Value = "Distinguished Name"
'objWorksheet.Cells(1, 2).Value = objUser.cn
'objWorksheet.Cells(2, 2).Value = objUser.sAMAccountName
'objWorksheet.Cells(3, 2).Value = objUser.displayName
'objWorksheet.Cells(4, 2).Value = objUser.distinguishedName
'objWorksheet.Cells(5, 1).Value = "Groups"
objWorksheet.Cells(1, 1).Value = "User Name"
objWorksheet.Cells(1, 2).Value = "Last Logon Time"
objWorksheet.Cells(1, 3).Value = "Number of Days"
k = 2
For Each strUser In objList
strDateDiff = DateDiff("d",objList(strUser),Date)
If DateDiff("d",objList(strUser),Date) > 30 Then
If objList(strUser) = #1/1/1601# Then
' Wscript.Echo strUser & ";" & "No Logon Date Found"
objWorksheet.Cells(k, 1).Value = strUser
objWorksheet.Cells(k, 2).Value = "No Logon Date Found"
objWorksheet.Cells(k, 3).Value = "0"
Else
' Wscript.Echo strUser & ";" & objList(strUser)
objWorksheet.Cells(k, 1).Value = strUser
objWorksheet.Cells(k, 2).Value = objList(strUser)
objWorksheet.Cells(k, 3).Value = strDateDiff
End If
End If
k = k + 1
Next
' Format the spreadsheet.
objWorksheet.UsedRange.EntireColumn.Autofit()
objWorksheet.Range("A1:C1").Font.Bold = True
Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1
Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("A1") 'Sort by Distinguished Name'
objRange.Sort objRange2, xlAscending, , , , , , xlYes
'objWorksheet.Select
'objWorksheet.Range("Z2").Select
'objExcel.ActiveWindow.FreezePanes = True
' Save the spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
' Quit Excel.
objExcel.Application.Quit
' Clean Up
Set objUser = Nothing
Set objGroup = Nothing
Set objWorksheet = Nothing
Set objExcel = Nothing
Wscript.Echo strExcelPath
Wscript.Echo "Done"
