'https://social.technet.microsoft.com/Forums/windows/en-US/71d90c68-342d-4083-ab21-97195e588fd0/query-for-expiration-date-of-ad-user-accounts-within-quotxquot-number-of-days?forum=ITCG
' AcctsAboutToExpire.vbs
' VBScript program to find accounts that will expire in the
' next 14 days.
Option Explicit
Dim objShell, lngBiasKey, lngTZBias
Dim adoConnection, adoCommand, objRootDSE, strDNSDomain
Dim strBase, strFilter, strAttributes, strQuery
Dim adoRecordset, strNTName, strDN
Dim dtmCritical1, lngSeconds1, str64Bit1
Dim dtmCritical2, lngSeconds2, str64Bit2
Dim objDate, dtmExpire
' 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
lngTZBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
lngTZBias = 0
For k = 0 To UBound(lngBiasKey)
lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
Next
End If
' Determine critical dates, now and 14 days in future.
dtmCritical1 = Now()
dtmCritical2 = DateAdd("d", 14, Now())
' Convert to UTC.
dtmCritical1 = DateAdd("n", lngTZBias, dtmCritical1)
dtmCritical2 = DateAdd("n", lngTZBias, dtmCritical2)
' Convert to seconds since 1/1/1601
lngSeconds1 = DateDiff("s", #1/1/1601#, dtmCritical1)
lngSeconds2 = DateDiff("s", #1/1/1601#, dtmCritical2)
' Convert to 100-nanosecond intervals
str64Bit1 = CStr(lngSeconds1) & "0000000"
str64Bit2 = CStr(lngSeconds2) & "0000000"
' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection
' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"
' Filter on user objects that expire between now and next 14 days.
strFilter = "(&(objectCategory=person)(objectClass=user)" _
& "(accountExpires>=" & str64Bit1 & ")" _
& "(accountExpires<=" & str64Bit2 & "))"
' Comma delimited list of attribute values to retrieve.
strAttributes = "distinguishedName,sAMAccountName,accountExpires"
' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False
' Run the query.
Set adoRecordset = adoCommand.Execute
' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
' Retrieve values and display.
strNTName = adoRecordset.Fields("sAMAccountName").Value
strDN = adoRecordset.Fields("distinguishedName").Value & ""
Set objDate = adoRecordset.Fields("accountExpires").Value
dtmExpire = Integer8Date(objDate, lngTZBias)
Wscript.Echo strDN & "," & strNTName & "," & dtmExpire
' Move to the next record in the recordset.
adoRecordset.MoveNext
Loop
' Clean up.
adoRecordset.Close
adoConnection.Close
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