VBScript: Get Disabled User Accounts

Another script that I wanted to share with the rest of the world. Please be aware that there is a bug that is preventing the replacing of dates with 1/1/1601 to Null (i.e. empty) when it creates the CSV file. If you can let me know how to fix this, then please feel free to tell me or share it in the comments section below.

'########### ORIGINAL SOURCE ###########################################
' PwdLastChanged.vbs
' ----------------------------------------------------------------------
' Copyright (c) 2003-2010 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
'########### ORIGINAL SOURCE ###########################################

'########### Non-Expiring Password Audit ################################
' This script checks for user accounts that are in active directory,    
' whose accounts are disabled. It will display their name, username,
' and the date of their last logon in a CSV file.
'
' History:
' Disabled_Users.vbs v1.0 - 11/15/2012
'
'#######################################################################
Option Explicit
Dim strFilePath, objFSO, objFile, adoConnection, adoCommand
Dim objRootDSE, strDNSDomain, strFilter, strQuery, adoRecordset
Dim strDN, objShell, lngBiasKey, lngBias, strPrncName, strLstLgDt
Dim objDate, k, curDate, curMonth, curDay
Dim strFldr, strFile, strFldrPath 

'Set up date variables
curDate = Date()
'strLstMnth = DateAdd("m",-1,curDate)
'strFldr = curDate '& Right(String(2, "0") & Month(strLstMnth),2) 
strFldr = Year(curDate) & Right(String(2, "0") & Month(curDate),2) 

'Check and see if a folder exists in the X:\mydrive\Disabled_Users\ directory
'using the YYYYMM format using the prior month's two digit number; if not, then create it, else create the
'CSV file using the current date in the European date format YYYYMMDD.
Dim fileSys, crtFldr

'Change the path between the quotes if needed
strFldrPath = "X:\mydrive\Disabled_Users\" & strFldr & "\"

Set fileSys = CreateObject("Scripting.FileSystemObject")

If Not fileSys.FolderExists(strFldrPath) Then
 Set crtFldr = fileSys.CreateFolder(strFldrPath)
End If
 
strFile = Year(curDate) & Right(String(2, "0") & Month(curDate),2) & Right(String(2, "0") & Day(curDate),2)
strFilePath = strFldrPath & strFile & ".csv"

Set objFSO = CreateObject("Scripting.FileSystemObject")

' Open the file for write access.
On Error Resume Next
Set objFile = objFSO.OpenTextFile(strFilePath, 2, True, 0)
If (Err.Number <> 0) Then
    On Error GoTo 0
    Wscript.Echo "File " & strFilePath & " cannot be opened"
    Wscript.Quit(1)
End If
On Error GoTo 0

' Obtain local time zone bias from machine registry.
' This bias changes with Daylight Savings Time.            
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


' Filter to retrieve all user objects. 
' NOTE: The line(s) containing (!sAMAccountName=) is used for filtering out user accounts with
' a specific set of characters, those without the * (asterisk) filters out a specific account.
strFilter = "(&(objectCategory=person)(objectClass=user)(userAccountControl:1.2.840.113556.1.4.803:=2))"

' Filter to retrieve all computer objects.
' strFilter = "(objectCategory=computer)"

'#################### Setup AD Connection & Create CSV File #############################################
'# The code below creatres the active directory connection and then uses the filter generated earlier.  #
'# From there it creates an LDAP query string and performs the actual enumeration of accounts whose     #
'# passwords never expire, along with their last password change date, username, etc. Once completed it #
'# will write each account into a comma delimited spreadsheet (CSV) file.        #
'########################################################################################################
' Use ADO to search the domain for all users.
Set adoConnection = CreateObject("ADODB.Connection")
Set adoCommand = CreateObject("ADODB.Command")
adoConnection.Provider = "ADsDSOOBject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

' Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext") 

strQuery = "<LDAP://" & strDNSDomain & ">;" & strFilter _
    & ";Name,userPrincipalName,lastLogon;subtree"

adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Enumerate all users. Write each user's Distinguished Name,
' when they last logon.
objFile.WriteLine "Name,Username,Last Logon Date"
Set adoRecordset = adoCommand.Execute
Do Until adoRecordset.EOF
    strDN = adoRecordset.Fields("Name").Value
 
 If (TypeName(adoRecordset.Fields("lastLogon").Value) = "Object") Then
        Set objDate = adoRecordset.Fields("lastLogon").Value
        strLstLgDt = Integer8Date(objDate, lngBias)
    Else
        strLstLgDt = NULL '#1/1/1601# 'Creates Null entries for dates with 1/1/1601
    End If
 
 strPrncName = adoRecordset.Fields("userPrincipalName").Value
    objFile.WriteLine strDN & "," & strPrncName & "," & strLstLgDt
    adoRecordset.MoveNext 
Loop
adoRecordset.Close

  ' Clean up.
objFile.Close
adoConnection.Close

'Open CSV file automatically after writing to it is completed
dim csvOpen
    set csvOpen = CreateObject("WScript.Shell")
     'csvOpen.Exec(strFilePath)
  csvOpen.Run Chr(34) & strFilePath & Chr(34), 1, false

  'Wscript.Echo "Done"

Function Integer8Date(ByVal objDate, ByVal lngBias)
    ' Function to convert Integer8 (64-bit) value to a date, adjusted for
    ' local time zone bias.
    Dim lngAdjust, lngDate, lngHigh, lngLow
    lngAdjust = lngBias
    lngHigh = objDate.HighPart
    lngLow = objdate.LowPart
    ' Account for error in IADsLargeInteger property methods.
    If (lngLow < 0) Then
        lngHigh = lngHigh + 1
    End If
    If (lngHigh = 0) And (lngLow = 0) Then
        lngAdjust = 0
    End If
    lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
        + lngLow) / 600000000 - lngAdjust) / 1440
    ' Trap error if lngDate is ridiculously huge.
    On Error Resume Next
    Integer8Date = CDate(lngDate)
    If (Err.Number <> 0) Then
        On Error GoTo 0
        Integer8Date = #1/1/1601#
    End If
    On Error GoTo 0
End Function