excel - 如何在 VBA 中管理从 ADsDSOObject 提供程序检索的日期对象？

Question

我正在使用 VBA 代码段(见下文)从 Active Directory 中检索具有某些属性的用户列表。

这适用于字符串数据，但是，我需要检索具有另一种格式 [1] 的 accountExpires 属性。当我尝试获取它时，它被识别为原始对象，因此它使我的 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 的常见数据类型:Integer8 日期，由 64 位整数表示。它存储一个值，表示自 1601 年 1 月 1 日以来发生的 100 纳秒。为什么？我不知道答案的好问题。但是，此标准在 Windows 中通常称为 FILETIME。因此，在非古代语言(不是 VBS/VBA)中，有非常简单的方法来处理这个问题:

电源外壳:

[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 位 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