How to manage in VBA Date objects retrieved from ADsDSOObject provider?

I am retrieving a list of users with some of their attributes from an Active Directory using a VBA code snippet (see below).

This works fine for string data, however, I need to retrieve the accountExpires attribute, which has another format [1]. When I try to get it, it is recognized as a raw Object, and thus it makes my CopyFromRecordset [2] method call fail. I also tried to use the Recordset.GetRows method, but to no avail.

What I want to do is to write in a readable / usable format the accountExpires value of each user account in a cell of my Excel worksheet. How can I do that?

Set objRootDSE = GetObject("LDAP://RootDSE")

strRoot = objRootDSE.GET("DefaultNamingContext")
strFilter = "(&(objectCategory=Person)(objectClass=User))"
strAttributes = "mail,distinguishedName,accountExpires"
strScope = "subtree"

Set cn = CreateObject("ADODB.Connection")
cn.Provider = "ADsDSOObject"
cn.Open "Active Directory Provider"

Set cmd = CreateObject("ADODB.Command")
cmd.ActiveConnection = cn
cmd.Properties("Page Size") = 1000

cmd.CommandText = "<LDAP://" & strRoot & ">;" & strFilter & ";" & _
                                   strAttributes & ";" & strScope
Set rs = cmd.Execute

Set objSheet = Sheets("AD Accounts")
objSheet.Cells.Clear

For i = 0 To rs.Fields.Count - 1
       objSheet.Cells(1, i + 1).Value = rs.Fields(i).Name
       objSheet.Cells(1, i + 1).Font.Bold = True
Next i
objSheet.Range("A2").CopyFromRecordset rs

rs.Close
cn.Close
Set objSheet = Nothing

Thanks a lot for your help!

[1] https://learn.microsoft.com/en-us/windows/win32/adschema/a-accountexpires

[2] https://learn.microsoft.com/en-us/office/vba/api/excel.range.copyfromrecordset

Solution

The datatype for accountexpires is a common one for ActiveDirectory: Integer8 date represented by a 64-bit integer. It stores a value that represents the 100s of nanoseconds that have occurred since Jan 1, 1601. Why? Great question that I don't know the answer to. However, this standard is commonly referred to in Windows as FILETIME. As such, in non-archaic languages (not VBS/VBA), there are very easy ways to handle this:

PowerShell:

[datetime]::FromFileTimeUtc($Int64FromAD)

For VBA/VBS, it's more difficult. Luckily for you, this was solved long ago: https://social.technet.microsoft.com/wiki/contents/articles/12814.active-directory-lastlogontimestamp-conversion.aspx:

Excel Forumla conversion: =IF(C2>0,C2/(8.64*10^11) - 109205,"")
Command-Line translation: w32tm.exe /ntte 128271382742968750

...that is, IF you can't use PowerShell. ;)

Edit:

My apologies for not completely reading what you requested. This is Richard Mueller's code (he is one of the most prominent VBS scripters I followed years ago)(https://social.technet.microsoft.com/Forums/en-US/216fe6ec-84de-4516-9110-12cc0a7ea9b0/is-there-a-way-to-add-the-last-login-timedate-in-ad-to-an-excel-column?forum=ITCG):

' 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



Then I add the following function at the end of the script:

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


Do Until adoRecordset.EOF
    ' Retrieve values and display.
    strName = adoRecordset.Fields("sAMAccountName").Value
    objSheet.Cells(intRow, 1).Value = strName
    strDN = adoRecordset.Fields("distinguishedName").value
    strDN = Replace(strDN, "/", "\/")
    objSheet.Cells(intRow, 2).Value = Mid(Split(strDN,",")(0),4)
    ' Retrieve lastLogonTimeStamp using Set statement.
    Set objDate = adoRecordset.Fields("lastLogonTimeStamp").Value
    ' Convert Integer8 value to date in local time zone.
    dtmLastLogon = Integer8Date(objDate, lngBias)
    objSheet.Cells(intRow, 3).Value = dtmLastLogon
    ' .... other statements. Be sure to adjust the column numbers,
    ' as I have inserted a column and those to the right of this one
    ' must be incremented accordingly.
Loop

He is showing this for lastlogontimestamp but again, the underlying datatype is the same (Integer8/64-bit Int) so just make the changes targeting the attribute name where necessary and update the objSheet.Cells() method to the row,column you want to write it to.

If you must use VBA/VBS for some reason, by all means but to show you how insanely easy this is with PowerShell versus what you're trying to do:

With Remote Server Administration Tools, Active Directory PowerShell tools:

    Get-ADUser -Filter * -Properties samaccountname,accountexpires,mail,distinguishedname | Export-Csv -NoTypeInformation AD_Export.csv

Without RSAT:

    $s = [adsisearcher]'(&(objectClass=user)(objectCategory=person))'
    $s.PropertiesToLoad.AddRange(@('samaccountname','accountexpires','mail','distinguishedname'))
    $r = $s.FindAll() | foreach-object {
       [pscustomobject]@{
          'samaccountname' = $_.Properties['samaccountname']
          'mail'           = $_.Properties['mail']
          'accountexpires' = [datetime]::FromFileTimeUtc($_.Properties['accountexpires'])
          'dn'             = $_.Properties['distinguishedname']
       }
    }

    $r | Export-Csv -NoTypeinformation Ad_Export.csv