Searching for locked accounts in Active Directory (Excel/VB)

Question

I'm trying to use Excel VBA to provide account information of user accounts on an Active Directory domain. I am struggling with options in the "Account tab in "Active Directory Users and Computers" specifically checking if an account is locked. I have the following code but no matter what I try to get the account locked status I cannot get an output or it fails (assuming my code attempt is invalid). The code I have so far that works for all other attributes in below. Can anyone suggest a way to extend the existing code to capture if the account is locked or not.

Thanks Steve

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

Answer 1

lockoutTime is tricky to use because you also need to take the lockout policy into account. Try msDS-User-Account-Control-Computed instead:

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