如何管理从 ADsDSOObject 提供程序检索到的 VBA 日期对象？

Question

我正在使用 VBA 代码片段（见下文）从 Active Directory 中检索用户列表及其某些属性。

这适用于字符串数据，但是，我需要检索具有另一种格式的 accountExpires 属性 [1]。当我尝试获取它时，它被识别为原始 Object，因此它使我的 CopyFromRecordset [2] 方法调用失败。我也尝试过使用Recordset.GetRows方法，但是没有用。

我想要做的是以可读/可用的格式在我的 Excel 工作表的单元格中写入每个用户帐户的 accountExpires 值。我该怎么做？

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

非常感谢您的帮助！

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

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

Answer 1

accountexpires 的数据类型是 ActiveDirectory 的常见数据类型：用 64 位整数表示的 Integer8 日期。它存储一个值，表示自 1601 年 1 月 1 日以来发生的 100 纳秒。为什么？我不知道答案的好问题。但是，此标准在 Windows 中通常称为 FILETIME。因此，在非古代语言（不是 VBS/VBA）中，有非常简单的方法来处理这个问题：

PowerShell：

[datetime]::FromFileTimeUtc($Int64FromAD)

对于VBA/VBS，难度更大。幸运的是，这个问题很久以前就解决了：https://social.technet.microsoft.com/wiki/contents/articles/12814.active-directory-lastlogontimestamp-conversion.aspx:

Excel 论坛转换：=IF(C2>0,C2/(8.64*10^11) - 109205,"")
命令行翻译：w32tm.exe /ntte 128271382742968750

...也就是说，如果您不能使用 PowerShell。 ;)

编辑：

很抱歉没有完全阅读您的要求。这是 Richard Mueller 的代码（他是我多年前关注的最杰出的 VBS 脚本编写者之一）(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

他正在为 lastlogontimestamp 展示这个，但同样，底层数据类型是相同的（Integer8/64-bit Int）所以只需在必要时针对属性名称进行更改并更新 objSheet.Cells() 方法到您要写入的行，列。

如果您出于某种原因必须使用 VBA/VBS，无论如何，但为了向您展示 PowerShell 与您尝试做的事情相比有多么简单：

使用远程服务器管理工具、Active Directory PowerShell 工具：

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

没有 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

如何管理从 ADsDSOObject 提供程序检索到的 VBA 日期对象？

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

excel

vba

ado

adodb

active-directory