在Active Directory中searchlocking的帐户（Excel / VB）
我正在尝试使用Excel VBA提供Active Directory域上的用户帐户的帐户信息。 我在“Active Directory用户和计算机”中的“帐户”标签中的选项中苦苦挣扎，特别检查一个帐户是否被locking。我有下面的代码，但不pipe我尝试获取帐户locking状态我无法获得输出或它失败（假设我的代码尝试是无效的）。我到目前为止的代码适用于下面的所有其他属性。任何人都可以build议一种方法来扩展现有的代码捕获，如果该帐户被locking或不。
感谢史蒂夫
Sub UpdateInfoFromAD() Dim wksSheet As Worksheet Dim strID As String Set wksSheet = Sheets("IDs") Application.ScreenUpdating = False 'Turns off screen updating ldapFilter = "(samAccountType=805306368)" Set rootDSE = GetObject("LDAP://rootDSE") domainDN = rootDSE.Get("defaultNamingContext") Set ado = CreateObject("ADODB.Connection") ado.Provider = "ADSDSOObject" ado.Open "ADSearch" strID = "A" i = 3 With wksSheet Do While Cells(i, 1).value <> "" .Range("B" & i & ":L" & i).ClearContents .Range("B" & i & ":L" & i).Borders.LineStyle = xlContinuous userSamAccountName = .Range(strID & i).value ldapFilter = "(samAccountName=" & userSamAccountName & ")" Set objectList = ado.Execute("<LDAP://" & domainDN & ">;" & ldapFilter & ";distinguishedName,samAccountName,displayname,userPrincipalName,Adspath,accountExpires,lockoutTime;subtree") While Not objectList.EOF Adspath = objectList.Fields("Adspath") Set oUser = GetObject(Adspath) On Error Resume Next Set llValue = oUser.Get("pwdLastSet") LastPWSet = "": LastPWSet = LargeIntegerToDate(llValue) Set llValue = oUser.Get("lastLogonTimestamp") LastLogon = "": LastLogon = LargeIntegerToDate(llValue) AccountDisabled = "": AccountDisabled = oUser.AccountDisabled Company = "": Company = oUser.Company Description = "": Description = oUser.Description oUser.GetInfoEx Array("canonicalName"), 0 canonicalName = "": canonicalName = oUser.canonicalName targetAddress = "": targetAddress = oUser.targetAddress mailPrimary = "": mailPrimary = oUser.mail tspp = "": tspp = oUser.TerminalServicesProfilePath HomeDirectory = "": HomeDirectory = oUser.HomeDirectory AccountExpirationDate = "": AccountExpirationDate = oUser.AccountExpirationDate If AccountExpirationDate = "01/01/1970" Then AccountExpirationDate = "" End If AccLock = oUser.lockoutTime .Range("B" & i).value = LastPWSet .Range("C" & i).value = LastLogon .Range("D" & i).value = AccountDisabled .Range("E" & i).value = AccountExpirationDate .Range("F" & i).value = Description .Range("G" & i).value = Company .Range("H" & i).value = canonicalName .Range("I" & i).value = HomeDirectory .Range("J" & i).value = tspp .Range("K" & i).value = mailPrimary .Range("L" & i).value = AccLock On Error GoTo 0 objectList.MoveNext Wend i = i + 1 Loop End With Application.ScreenUpdating = True 'Turns on screen updating MsgBox "Done" End Sub Function LargeIntegerToDate(value) 'takes Microsoft LargeInteger value (Integer8) and returns according the date and time 'first determine the local time from the timezone bias in the registry Set sho = CreateObject("Wscript.Shell") timeShiftValue = sho.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias") If IsArray(timeShiftValue) Then timeShift = 0 For i = 0 To UBound(timeShiftValue) timeShift = timeShift + (timeShiftValue(i) * 256 ^ i) Next Else timeShift = timeShiftValue End If 'get the large integer into two long values (high part and low part) i8High = value.HighPart i8Low = value.LowPart If (i8Low < 0) Then i8High = i8High + 1 End If 'calculate the date and time: 100-nanosecond-steps since 12:00 AM, 1/1/1601 If (i8High = 0) And (i8Low = 0) Then LargeIntegerToDate = #1/1/1601# Else LargeIntegerToDate = #1/1/1601# + (((i8High * 2 ^ 32) + i8Low) / 600000000 - timeShift) / 1440 End If End Function lockoutTime使用lockoutTime很棘手，因为你也需要考虑locking策略。 尝试使用msDS-User-Account-Control-Computed来代替：
Const UF_LOCKOUT = &H10 oUser.GetInfoEx Array("msDS-User-Account-Control-Computed"), 0 AccLock = (oUser.Get("msDS-User-Account-Control-Computed") And UF_LOCKOUT) = UF_LOCKOUT