VBS: Get old computer accounts from AD

UPDATED 2011-02-10: Added support for 33000+ records. Thanks to Mike for finding the limitation and testing the solution. (Note for 33000 records script takes about 1.5hrs to run)

The VBScript loops through the AD and lists all of the computer accounts in a csv file.

The Excel Code does the same except places the data in a formated table in excel, note it is only tested with excel 2007.

The following properties are returned:

  • Hostname,
  • Password Last Set,
  • Day Count (since password was last set),
  • Recent (was this done within the days specified in the script),
  • Disabled?,
  • Top Level OU,
  • OU,
  • Distinguished Name


Excel VBA Script

Remove the “.txt” extensions and then import into a blank excel spreadsheet (Look under Developer -> Visual Basic) .

Reame the 1st tab of the spreadsheet to “Current”

Using the design tools create a button called “btnUpdate”

Insert the number of days a computer since the last passwd change in cell J5 (defaults to 150)

  • [download id=”13″]
  • [download id=”14″]


  • [download id=”12″]
Option Explicit

Dim objConn, objCmd, objRS, objComp, objDate, objFSO, objFile
Dim strQuery, arrProvider, strFilter, strFields, strScope

Dim lngBias

' User Changeable
Const OUT_FILE = "computers.csv"
'Current Machines
Const intDays = 150

' Constants
Const forREADING = 1
Const forWRITING = 2
Const forAPPENDING = 8


strFilter = "(objectCategory=computer);"
strFields = "distinguishedName"
strScope = ";subtree"

Set objConn = CreateObject("ADODB.Connection")
Set objCmd = CreateObject("ADODB.Command")
objConn.Provider = “ADsDSOObject”
objConn.Open “Active Directory Provider”
objCmd.ActiveConnection = objConn

'wscript.echo Ubound(arrProvider)
Dim i
for i=0 to Ubound(arrProvider)
  strQuery = "<" & arrProvider(i) & ">;" & strFilter & strFields & strScope
  'wscript.echo i

Set objConn = Nothing
Set objCmd = Nothing

wscript.echo "Done"

Sub getTopLevelOUs
  Dim objRootDSE, strBaseConnString, objOULevel, objOUObject, tmp

  Set objRootDSE = GetObject("LDAP://RootDSE")
  strBaseConnString = objRootDSE.Get("defaultNamingContext")
  Set objOULevel = GetObject("LDAP://" & strBaseConnString)
  tmp = ""
  For Each objOUObject In objOULevel
    tmp = tmp & "LDAP://" & objOUObject.distinguishedName & "|"
  tmp = left(tmp,len(tmp)-1)

  arrProvider = split(tmp,"|")
End Sub

Sub getComputers(qry)
  Dim strName, dtmPwdLastSet, strOU, strSite, strOut, strTopOU
  Dim comp, tmp, disabled
  objCmd.CommandText = qry
  objCmd.Properties(“Page Size”) = 1000
  objCmd.Properties(“Timeout”) = 300
  objCmd.Properties(“Cache Results”) = False
  objCmd.Properties(“Size Limit”) = 75000
  Set objRs = objCmd.Execute

  strOut = ""
  While Not objRs.EOF
    if strOut <> "" Then
      strOut = strOut & vbcrlf
    end if
    ' Get the LDAP Record
    ' use distinguished name to provide a direct link to the object
    comp = "LDAP://" & objRs.Fields("distinguishedName")
    ' Create a Computer object
    Set objComp = GetObject(comp)
    Set objDate = objComp.PwdLastSet
    dtmPwdLastSet = Integer8Date(objDate, lngBias)

    'Is Computer account Disabled?
    If objComp.AccountDisabled <> 0 Then
      disabled = "TRUE"
      disabled = "FALSE"
    end if

    strName = objComp.sAMAccountName
    strName = left(strName,len(strName)-1)

    ' Normalise OU so it is user friendly and get site
    tmp = Split(objComp.distinguishedName,",")
    strOU = ""
    Dim i
    for i = Ubound(tmp) to 1 Step -1
      if (i = Ubound(tmp)) then
        strOU = right(tmp(i-1),len(tmp(i-1))-3) & "." & right(tmp(i),len(tmp(i))-3)
        strTopOU = right(tmp(i-2),len(tmp(i-2))-3)
        i = i-1
        strOU = strOU & "/" & right(tmp(i),len(tmp(i))-3)
      end if

    Dim recent, ddiff
    ddiff = DateDiff("d", dtmPwdLastSet, Now)
    If (ddiff > intDays) Then
      recent = "FALSE"
      recent = "TRUE"
    end if

    strOut = strOut & strName & "," & dtmPwdLastSet & "," & ddiff & "," & _
                recent & "," & disabled & "," & strTopOU & "," & strOU & ",""" & objRs.Fields("distinguishedName") & """"
  if (strOut <> "") Then
  end if

  Set objComp = Nothing
  Set objRs = Nothing
  Set objDate = Nothing
End Sub

Function Integer8Date(ByVal objDate, ByVal lngBias)
  ' Function to convert Integer8 (64-bit) value to a date, adjusted for
  ' local time zone bias.
  Dim lngAdjust, lngDate, lngHigh, lngLow
  lngAdjust = lngBias
  lngHigh = objDate.HighPart
  lngLow = objdate.LowPart
  ' Account for bug in IADslargeInteger property methods.
  If (lngLow < 0) Then
    lngHigh = lngHigh + 1
  End If
  If (lngHigh = 0) And (lngLow = 0) Then
    lngAdjust = 0
  End If
  lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
                + lngLow) / 600000000 - lngAdjust) / 1440
  Integer8Date = CDate(lngDate)
End Function

sub getTimeBias()
  ' Obtain the local time zone bias from machine registry
  Dim objShell, lngBiasKey
  Set objShell = CreateObject("Wscript.Shell")
  lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
                    & "TimeZoneInformation\ActiveTimeBias")
  If (UCase(TypeName(lngBiasKey)) = "LONG") Then
    lngBias = lngBiasKey
  ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
    lngBias = 0
    For k = 0 To UBound(lngBiasKey)
      lngBias = lngBias + (lngBiasKey(k) * 256^k)
  End If
end sub

sub wfile(outtxt)
  Set objFSO = CreateObject("Scripting.FileSystemObject")

  IF objFSO.FileExists(OUT_FILE) Then
    Set objFile = objFSO.OpenTextFile(OUT_FILE, forAPPENDING)
    Set objFile = objFSO.CreateTextFile(OUT_FILE)
    Set objFile = objFSO.OpenTextFile(OUT_FILE, forWRITING)
    objFile.Writeline "Hostname,Password Last Set,Day Count,Recent,Disabled?,Top Level OU,OU,Distinguished Name"
  End If

  objFile.Writeline outtxt
end sub

6 thoughts to “VBS: Get old computer accounts from AD”

  1. Mike,

    I think I have a solution.
    Replace Line 27 with the following:

    objConn.Provider = “ADsDSOObject”
    objConn.Open “Active Directory Provider”

    Then replace Line 62 with:
    objCmd.CommandText = qry
    objCmd.Properties(“Page Size”) = 1000
    objCmd.Properties(“Timeout”) = 300
    objCmd.Properties(“Cache Results”) = False
    objCmd.Properties(“Size Limit”) = 75000

    Let me know if that helps



  2. Mike,
    4096.. a power of 2 I think you are on to something.

    I am afraid I don’t have enough objects in my domain to be able to replicate this, but I’ll do my best to work through it with you and see if we can fix it.

    I suspect that the recordset is perhaps being maxed out.



  3. I ran through the suggested tests. Using csript and the echos it reports a total number, counts down, and then Done leading me to believe it has successfully ran. I moved a computer object it is finding to a sub OU that is not being reported and it finds the computer object in this OU. I move a computer object not being found into an OU that is being found and this moved object is not found in the output file. One thing that is consistent is that the output CSV file is always 4096 objects, not counting the header. It seems as if the script buffer is 4mb and once it reaches capacity the script ends. I even went so far as to delete and ‘old’ object that was being found in the CSV file, moved an object not being found to an OU that was being found. The output CSV file did not contain this moved object yet still contained 4096 entries.

  4. Mike,

    Can you move one of the computers it is finding down 1 level into a sub-OU that you don’t believe is being parsed and see if it gets found. This will prove that it is/is not looking in sub-OUs.

    When I run it (in a win2k3 env) I am getting about 2000 computers back which is about right for me and it is listing sub-OUs.

    If you run the script from the commandline using:
    “cscript ADCompAccounts.vbs” Do you see “Done” appear? if not it is possible the script is crashing.



    Do you have permissions on all the OUs? I am running it from a Domain admin account.

  5. Hi Mike,

    I haven’t looked at this code in a while but if you uncomment the “wscript.echo” lines those should tell you which OUs you are entering if my memory serves.

    I’ll try and run it over the weekend if not then Monday and take a look if you are still stuck.



  6. Hello Ryan, thanks for the ADCompAccounts.vbs code. When I run this in my W2k3 environment I get a subset of computers and not an entire listing. Within a ‘Workstation’ OU there are a few sub OU’s which may be creating some confusion. To get around this I changed the following code:
    ‘ Set objOULevel = GetObject(“LDAP://” & strBaseConnString)


    Set objOULevel = GetObject(“LDAP://OU=Workstations….

    I pointed the script to the actual OU that I was interested in. What I received were computer accounts from this OU, the sub OU’s which I expected but I also received computer accounts located in a ‘Servers’ OU that is at the same level as ‘Workstations’ along with many duplicate entries.

    Have you seen this behavior or do you have any idea why it is not iterating my AD structure?

Leave a Reply

Your email address will not be published. Required fields are marked *


This blog is kept spam free by WP-SpamFree.