2
我试图使用Excel VBA提供Active Directory域上的用户帐户的帐户信息。我在“Active Directory用户和计算机”中的“帐户”选项卡中苦苦寻找选项，专门检查帐户是否被锁定。我有以下代码，但不管我尝试获取帐户锁定状态我无法获得输出或它失败（假设我的代码尝试是无效的），我到目前为止的代码适用于以下所有其他属性：任何人都可以推荐一种方法来扩展现有代码以捕获帐户是否被锁定。 史蒂夫在Active Directory中搜索锁定帐户（Excel/VB）
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