On Error Resume Next

'Create Excel Object
Set objExcel = CreateObject("Excel.Application")
'Open the excel spreadsheet
Set objWorkbook = objExcel.Workbooks.Open _
("C:\SpreadSheet.xls")

' A couple of variables
intRow = 1
Username = ""
IsAccountDisabled = ""

'Do read the cell value in each row until there is a row with no data in it
Do Until objExcel.Cells(intRow,1).Value = ""
' The variable Username will hold the data from Cell 1, then a space and then the data from cell 2
Username = objExcel.Cells(intRow, 1).Value & " " & objExcel.Cells(intRow, 2)
'Convert Username to all lowercase, better for AD search
Username = Lcase(Username)

'----------------------------------------------------------------------------

Const ADS_SCOPE_SUBTREE = 2
Const ADS_UF_ACCOUNTDISABLE = 2

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") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

objCommand.CommandText = _
"SELECT ADsPath FROM 'LDAP://dc=microsoft,dc=com' WHERE objectCategory='user' " & _
"AND name=' " & Username & "'"
Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst
Do Until objRecordSet.EOF
objExcel.Cells(intRow, 3).Value = "Found"
UserVar = objRecordSet.Fields("ADsPath").Value
Dim objUSer
Set objUser = GetObject(Uservar)

If objUser.AccountDisabled = False Then
IsAccountDisabled = "Enabled"
else
IsAccountDisabled = "Disabled"
end if

objExcel.Cells(intRow, 4).Value = IsAccountDisabled
IsAccountDisabled = ""
objRecordSet.MoveNext
Loop

'If the user does not exist in AD
IF UserVar = "" then
objExcel.Cells(intRow, 3).Value = "Not Found"
End If
UserVar = ""

' Move on to the next row
intRow = intRow + 1
' Go back to the beginning of the loop
Loop

'Destroy Excel Object
objExcel.Save
objExcel.Quit

msgbox("Script Done")