Script to extract users data from Active Directory (VBS)

This script will extract users data (machine name, last logon,OS,OU name) from your AD and it will autocratically save into a .csv file :



********************************************

'====================================================================
'
' NAME: 
'
' AUTHOR:  
' DATE  : 11/01/2012
'
' COMMENT: 
'Exemplary damages arising out of or in any way relating to the use of this script, 
'including without limitation damages for loss of goodwill, work stoppage, 
'lost profits, loss of data, and computer failure or malfunction. 
'You bear the entire risk as to the quality and performance of this script.
'
'
'====================================================================

Set objFSO = CreateObject("Scripting.FileSystemObject")

Dim HostName, DisName, Domain 
Dim Ruta(51) 

    'Sheets("AD_Computers").Select

Set adoCommand = CreateObject("ADODB.Command")
Set ADOConnection = CreateObject("ADODB.Connection")
ADOConnection.Provider = "ADsDSOObject"
ADOConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = ADOConnection

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on computer objects.
strFilter = "(&(objectCategory=computer))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "name,distinguishedName,lastLogonTimestamp,operatingSystem"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute
Domain = "Domain.COM"

    Set FICHERO = objFSO.opentextfile("AD_COMPUTERS.csv", 2, True)
     FICHERO.WRITELINE "Machine Name;lastLogonTimeStamp;Operating System;System OU Name"
    FICHERO.Close

' Enumerate the resulting recordset.

Do Until adoRecordset.EOF
i = i + 1

    On Error Resume Next
    HostName = adoRecordset.Fields("name").Value
    DisName = adoRecordset.Fields("distinguishedName").Value
OS = adoRecordset.Fields("operatingSystem").Value

   Set objDate = adoRecordset.Fields("lastLogonTimeStamp").Value
    
    If (Err.Number <> 0) Then
        On Error GoTo 0
        dtmDate = #1/1/1601#
    Else
        On Error GoTo 0
        lngHigh = objDate.HighPart
        lngLow = objDate.LowPart
        If (lngLow < 0) Then
            lngHigh = lngHigh + 1
        End If
        If (lngHigh = 0) And (lngLow = 0) Then
            dtmDate = #1/1/1601#
        Else
            dtmDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) + lngLow) / 600000000 - lngBias) / 1440
        End If
    End If

    ' Display values for the user.
    If (dtmDate = #1/1/1601#) Then
        Tiempo = "Never"
    Else
        Tiempo = dtmDate
Tiempo = left(Tiempo,InStr(1,Tiempo, " ") -1)
Tiempo = day (Tiempo) & "/" & month (Tiempo)  & "/" & year (Tiempo)
    End If

    distinguishedName = DisName
     

AD = Split(DisName, ",")
    
    i2 = 50
    For Each Item In AD
      If Left(Item, 3) = "OU=" Then
       Ruta(i2) = Replace(Item, "OU=", "/")
       i2 = i2 - 1
      End If
      
    Next
    
    DisName = ""
    For i3 = 1 To 50
    If Ruta(i3) <> "" Then DisName = DisName + Ruta(i3)
    
    Next

    
    If DisName = "" Then DisName = "/COMPUTERS"
    

    Set FICHERO = objFSO.opentextfile("AD_COMPUTERS.csv", 8, True)
     on error resume next
     FICHERO.WRITELINE ucase(HostName) & ";" & Tiempo & ";" & OS & ";" & ucase(Domain & DisName)
     on error goto 0
    FICHERO.Close
    


    'Range("A" & i).Select
   ' Range("A" & i).Value = HostName
   ' Range("B" & i).Value = Domain & DisName
   ' Range("C" & i).Value = distinguishedName

'If i = 5760 Then
'MsgBox "va"
'End If
    'Move to the next record in the recordset.
     adoRecordset.MoveNext
     Erase Ruta

Loop
' Clean up.
adoRecordset.Close
ADOConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set ADOConnection = Nothing
Set adoCommand = Nothing

msgbox "END"

**************************************