2
Active Directoryドメイン上のユーザーアカウントのアカウント情報を提供するためにExcel VBAを使用しようとしています。私は、 "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