VB宏中的pwdLastSet

问题描述

Option Explicit
Const ADS_SCOPE_SUBTREE = 2
Sub LoadUserInfo()
    Dim x, objConnection, objCommand, objRecordSet, oUser, skip, disa
    Dim sht As Worksheet

    ' get domain
    Dim oRoot
    Set oRoot = GetObject("LDAP://rootDSE")
    Dim sDomain
    sDomain = oRoot.Get("defaultNamingContext")
    Dim strLDAP
    strLDAP = "LDAP://OU=ExxonExecutives," & sDomain
    MsgBox strLDAP

    Set objConnection = CreateObject("ADODB.Connection")
    Set objCommand = CreateObject("ADODB.Command")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection
    objCommand.Properties("Page Size") = 100
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

    objCommand.CommandText = "SELECT adsPath FROM '" & strLDAP & "' WHERE objectCategory='person'AND objectClass='user'"
    Set objRecordSet = objCommand.Execute

    x = 2
    Set sht = ThisWorkbook.Worksheets("Company")
    With sht
        ' Clear and set Header info
        .Cells.Clear
        .Cells.NumberFormat = "@"
        .Cells(1, 1).Value = "Login"
        .Cells(1, 2).Value = "Name"
        .Cells(1, 3).Value = "Surmane"
        .Cells(1, 4).Value = "Display Name"
        .Cells(1, 5).Value = "Departement"
        .Cells(1, 6).Value = "Title"
        .Cells(1, 7).Value = "Telephone"
        .Cells(1, 8).Value = "Mobile"
        .Cells(1, 9).Value = "Fax"
        .Cells(1, 10).Value = "Initials"
        .Cells(1, 11).Value = "Company"
        .Cells(1, 12).Value = "Address"
        .Cells(1, 13).Value = "P.O. box"
        .Cells(1, 14).Value = "Zip"
        .Cells(1, 15).Value = "Town"
        .Cells(1, 16).Value = "State"
        .Cells(1, 17).Value = "Manager"
        .Cells(1, 18).Value = "Password Last Changed"
        Do Until objRecordSet.EOF
            Set oUser = GetObject(objRecordSet.Fields("aDSPath"))
            skip = oUser.sAMAccountName
            disa = oUser.AccountDisabled

            If (skip = "Administrator") Or (skip = "Guest") Or (skip = "krbtgt") Or (disa = "True") Then
                .Cells(x, 1).Value = "test"
                DoEvents
                objRecordSet.MoveNext
            Else
                .Cells(x, 1).Value = CStr(oUser.sAMAccountName) 'Replace(oUser.Name, "CN=", "")
                .Cells(x, 2).Value = oUser.givenName
                .Cells(x, 3).Value = oUser.SN
                .Cells(x, 4).Value = oUser.DisplayName
                .Cells(x, 5).Value = oUser.department
                .Cells(x, 6).Value = oUser.Title
                .Cells(x, 7).Value = oUser.telephoneNumber
                .Cells(x, 8).Value = oUser.mobile
                .Cells(x, 9).Value = oUser.facsimileTelephoneNumber
                .Cells(x, 10).Value = oUser.initials
                .Cells(x, 11).Value = oUser.company
                .Cells(x, 12).Value = oUser.streetAddress
                .Cells(x, 13).Value = oUser.postOfficeBox
                .Cells(x, 14).Value = oUser.postalCode
                .Cells(x, 15).Value = oUser.l ' by
                .Cells(x, 16).Value = oUser.st
                .Cells(x, 17).Value = oUser.manager
                .Cells(x, 18).Value = oUser.pwdLastSet // CRAAAASH!
                DoEvents
                x = x + 1
                objRecordSet.MoveNext
            End If

        Loop

    End With
    Range("A1:D1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.AutoFilter
    Range("C12").Select

End Sub

我得到了pwdLastSet属性。我收到应用程序定义或对象定义的错误

I get get the pwdLastSet property. I get Application-defined or object defined error

推荐答案

pwdLastSet 是64位整数：

对于VB，该对象具有两个Long属性： HighPart 和 LowPart

For VB it is an object with two Long properties: HighPart and LowPart

您需要的东西，来自

' 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


Set objUser = GetObject("LDAP://" & strUserDN)

'--- These are the two relevant lines ---
Set objDate = objUser.pwdLastSet
dtmPwdLastSet = Integer8Date(objDate, lngBias)


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

这篇关于VB宏中的pwdLastSet的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！