VBScript Code to List Active Directory Data in a Spreadsheet

You can use any of the VBScript programs below in ActiveXperts Network Monitor. Click here for an explanation about how to include scripts in ActiveXperts Network Monitor.

Example(s)

Const ADS_SCOPE_SUBTREE = 2

Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True
objExcel.Workbooks.Add

objExcel.Cells(1, 1).Value = "Last name"
objExcel.Cells(1, 2).Value = "First name"
objExcel.Cells(1, 3).Value = "Department"
objExcel.Cells(1, 4).Value = "Phone number"

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") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
objCommand.CommandText = _
    "SELECT givenName, SN, department, telephoneNumber FROM " _
        & "'LDAP://dc=fabrikam,dc=microsoft,dc=com' WHERE " _
            & "objectCategory='user'"  
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
x = 2

Do Until objRecordSet.EOF
    objExcel.Cells(x, 1).Value = _
        objRecordSet.Fields("SN").Value
    objExcel.Cells(x, 2).Value = _
        objRecordSet.Fields("givenName").Value
    objExcel.Cells(x, 3).Value = _
        objRecordSet.Fields("department").Value
    objExcel.Cells(x, 4).Value = _
        objRecordSet.Fields("telephoneNumber").Value
    x = x + 1
    objRecordSet.MoveNext
Loop

Set objRange = objExcel.Range("A1")
objRange.Activate

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

Set objRange = objExcel.Range("C1")
objRange.Activate

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

Set objRange = objExcel.Range("D1")
objRange.Activate

Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()

Set objRange = objExcel.Range("A1").SpecialCells(11)
Set objRange2 = objExcel.Range("C1")
Set objRange3 = objExcel.Range("A1")