Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
'List all computers in an AD domain running XP by SP using ADO.
'Output to Excel spreadsheet.
On Error Resume Next
'Initialize constants and variables.
Const xlAscending = 1
Const xlYes = 1
Const ADS_SCOPE_SUBTREE = 2
g_strContainer = "dc=****your DOMAIN NAME ******,dc=lan"
strQuery = "SELECT CN, operatingSystemVersion, operatingSystemServicePack " _
& "FROM 'LDAP://" & g_strContainer & "' WHERE objectCategory='computer'"
strOutputFile = "c:\scripts\xpsp.xls"
g_strSP2 = ""
g_strSP1 = ""
g_strSP0 = ""
g_strNotXP = ""
g_intSP2 = 0
g_intSP1 = 0
g_intSP0 = 0
g_intNotXP = 0
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = ("ADsDSOObject")
objConnection.Open "Active Directory Provider"
If Err <> 0 Then
HandleError Err, "Unable to connect to AD Provider with ADO."
End If
objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = strQuery
Set objRecordSet = objCommand.Execute
If Err <> 0 Then
HandleError Err, "Unable to execute ADO query."
End If
WScript.Echo "Gathering data from Active Directory ..."
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
If objRecordSet.Fields("operatingSystemVersion").Value = "5.1 (2600)" Then
If objRecordSet.Fields("operatingSystemServicePack").Value = _
"Service Pack 2" Then
g_strSP2 = g_strSP2 & objRecordSet.Fields("CN").Value & ","
g_intSP2 = g_intSP2 + 1
ElseIf objRecordSet.Fields("operatingSystemServicePack").Value = _
"Service Pack 1" Then
g_strSP1 = g_strSP1 & objRecordSet.Fields("CN").Value & ","
g_intSP1 = g_intSP1 + 1
Else
g_strSP0 = g_strSP0 & objRecordSet.Fields("CN").Value & ","
g_intSP0 = g_intSP0 + 1
End If
Else
g_strNotXP = g_strNotXP & objRecordSet.Fields("CN").Value & ","
g_intNotXP = g_intNotXP + 1
End If
objRecordSet.MoveNext
Loop
If Err <> 0 Then
HandleError Err, "Unable to gather data."
End If
WScript.Echo "Writing data to spreadsheet ..."
WriteSpreadsheet strOutputFile
WScript.Echo "Data written to " & strOutputFile
'******************************************************************************
'Write data to spreadsheet.
Sub WriteSpreadsheet(strFileName)
'On Error Resume Next
'Create spreadsheet and open workbook.
Set objExcel = CreateObject("Excel.Application")
objExcel.Workbooks.Add
'Write data to spreadsheet.
objExcel.Cells(1,1).Value = "Inventory of Windows XP Service Packs"
objExcel.Cells(1,1).Font.Bold = True
objExcel.Cells(1,1).Font.Size = 13
objExcel.Cells(2,1).Value = "Time: " & Now
objExcel.Cells(2,1).Font.Bold = True
objExcel.Cells(2,5).Value = "Container: " & g_strContainer
objExcel.Cells(2,5).Font.Bold = True
objExcel.Cells(3,1).Value = "Total Computers: "
objExcel.Cells(3,1).Font.Bold = True
objExcel.Cells(3,3).Value = g_intSP2 + g_intSP1 + g_intSP0 + g_intNotXP
objExcel.Cells(3,3).Font.Bold = True
objExcel.Cells(4,1).Value = "Computers Running Windows XP"
objExcel.Cells(4,1).Font.Bold = True
objExcel.Cells(4,1).Font.Size = 12
objExcel.Cells(5,1).Value = "Number"
objExcel.Cells(5,1).Font.Bold = True
objExcel.Cells(6,1).Value = g_intSP2 + g_intSP1 + g_intSP0
objExcel.Cells(8,1).Value = "Service Pack 2"
objExcel.Cells(8,1).Font.Bold = True
objExcel.Cells(8,1).Font.Size = 11
objExcel.Cells(9,1).Value = "Number"
objExcel.Cells(9,1).Font.Bold = True
objExcel.Cells(10,1).Value = g_intSP2
objExcel.Cells(9,2).Value = "Names"
objExcel.Cells(9,2).Font.Bold = True
arrSP2 = Split(g_strSP2, ",")
x = 10
For Each strSP2 In arrSP2
objExcel.Cells(x,2).Value = strSP2
x = x + 1
Next
Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objSortRange = objExcel.Range("B9:B" & x)
Set objSortKey = objExcel.Range("B10")
objSortRange.Sort objSortKey,xlAscending,,,,,,xlYes
objExcel.Cells(8,3).Value = "Service Pack 1"
objExcel.Cells(8,3).Font.Bold = True
objExcel.Cells(8,3).Font.Size = 11
objExcel.Cells(9,3).Value = "Number"
objExcel.Cells(9,3).Font.Bold = True
objExcel.Cells(10,3).Value = g_intSP1
objExcel.Cells(9,4).Value = "Names"
objExcel.Cells(9,4).Font.Bold = True
arrSP1 = Split(g_strSP1, ",")
x = 10
For Each strSP1 In arrSP1
objExcel.Cells(x,4).Value = strSP1
x = x + 1
Next
Set objRange = objExcel.Range("D1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objSortRange = objExcel.Range("D9" & x)
Set objSortKey = objExcel.Range("D10")
objSortRange.Sort objSortKey,xlAscending,,,,,,xlYes
objExcel.Cells(8,5).Value = "No Service Pack"
objExcel.Cells(8,5).Font.Bold = True
objExcel.Cells(8,5).Font.Size = 11
objExcel.Cells(9,5).Value = "Number"
objExcel.Cells(9,5).Font.Bold = True
objExcel.Cells(10,5).Value = g_intSP0
objExcel.Cells(9,6).Value = "Names"
objExcel.Cells(9,6).Font.Bold = True
arrSP0 = Split(g_strSP0, ",")
x = 10
For Each strSP0 In arrSP0
objExcel.Cells(x,6).Value = strSP0
x = x + 1
Next
Set objRange = objExcel.Range("F1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objSortRange = objExcel.Range("F9:F" & x)
Set objSortKey = objExcel.Range("F10")
objSortRange.Sort objSortKey,xlAscending,,,,,,xlYes
objExcel.Cells(4,7).Value = "Not Running Windows XP"
objExcel.Cells(4,7).Font.Bold = True
objExcel.Cells(4,7).Font.Size = 12
objExcel.Cells(5,7).Value = "Number"
objExcel.Cells(5,7).Font.Bold = True
objExcel.Cells(6,7).Value = g_intNotXP
objExcel.Cells(5,8).Value = "Names"
objExcel.Cells(5,8).Font.Bold = True
arrNotXP = Split(g_strNotXP, ",")
x = 6
For Each strNotXP In arrNotXP
objExcel.Cells(x,8).Value = strNotXP
x = x + 1
Next
Set objRange = objExcel.Range("H1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit()
Set objSortRange = objExcel.Range("H5:H" & x)
Set objSortKey = objExcel.Range("H6")
objSortRange.Sort objSortKey,xlAscending,,,,,,xlYes
'Move active cell back to A1.
Set objRange = objExcel.Range("A1")
objRange.Activate
'Force save and close spreadsheet.
objExcel.DisplayAlerts = False
Set objWorkbook = objExcel.ActiveWorkbook
objWorkbook.SaveAs strFileName
objWorkbook.Close
objExcel.Quit
End Sub
'******************************************************************************
'Handle errors.
Sub HandleError(Err, strMsg)
On Error Resume Next
WScript.Echo " " & strMsg
WScript.Echo " Error Number: " & Err.Number
WScript.Echo " Source: " & Err.Source
WScript.Echo " Description: " & Err.Description
WScript.Quit
End Sub