Listing 1: ADOExcel.vbs

' ******* BEGIN CALLOUT A *******
' Change the Excel extension to coincide with your version of Excel.
SourceXLS = "C:\temp\~Test~Spread~Sheet.xlsx"
' ******* END CALLOUT A *******

NumberOfFields = 4 : NumberOfRows = 4

' Create source spreadsheet and add a worksheet named ADOExcel.
Set XL = CreateObject("Excel.Application")
XL.workbooks.Add
XL.sheets.add.name = "ADOExcel"

' Add x number of fields (column) names 
' (e.g., Header0, Header1, Header2, Header3).
Row = 1
For Col = 1 to NumberOfFields
  XL.Cells(Row,Col).value = "Header" & Col -1
Next

' Create x number of sample records (rows).
For Row = 2 to NumberOfRows
  For Col = 1 to NumberOfFields
    XL.Cells(Row,Col).value = "RecordField " & (Row) & "@" & (Col -1)
  Next
Next

XL.Rows("2:2").Select
XL.ActiveWindow.FreezePanes = True
XL.Cells.EntireColumn.AutoFit
XL.Range("A1").Select
XL.Application.DisplayAlerts = False
XL.Activeworkbook.SAVEAS SourceXLS
XL.Application.DisplayAlerts = True
XL.Visible = True

Set oConn = CreateObject("ADODB.Connection")

' ******* BEGIN CALLOUT B *******
' If you're using a Universal Data Link connection, uncomment this line
' and comment out the Excel 2007 provider connection code.
' oConn.ConnectionString = "File Name=C:\temp\xls.udl"

' If you're using Excel 2000 or Excel 2003, uncomment these lines and
' and comment out the Excel 2007 provider connection code.
' oConn.connectionstring = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
' "Data Source=" & SourceXLS & ";" & _
' "Extended Properties=""Excel 8.0;HDR=YES;"""

' Set up Excel provider connection for Excel 2007
oConn.connectionstring = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
  "Data Source=" & SourceXLS & ";" & _ 
  "Extended Properties=""Excel 12.0;HDR=YES;""" 
' ******* END CALLOUT B *******

oConn.Open

' Create a Recordset object.
' ******* BEGIN CALLOUT C *******
Const adOpenKeyset = 1
Const adLockOptimistic = 3
Set oRS = CreateObject("ADODB.Recordset")
oRS.Open "Select * from [ADOExcel$]",oConn,adOpenKeyset,adLockOptimistic
' ******* END CALLOUT C *******

' ******* BEGIN CALLOUT D *******
MsgBox "ADO Version: " & oconn.Version & vbcrlf & _
 "Provider: " & oconn.Provider & vbcrlf & _
 "Record Count: " & oRS.RecordCount & vbcrlf & _
 "Field count: " & oRS.Fields.Count
' ******* END CALLOUT D *******

' ******* BEGIN CALLOUT E *******
' Add two new records and put values into each field.
For Row = 1 to 2
  oRS.MoveLast
  NewPosition = CStr(oRS.AbsolutePosition + 2)
  oRS.AddNew
  For Col = 0 To NumberOfFields - 1
    oRS.Fields(Col).Value = "RecordField " & NewPosition & "@" & CStr(Col)
  Next
  oRS.Update
Next
' XL.Cells.EntireColumn.AutoFit
MsgBox "Just added Two New Records." & vbcrlf & _
  "Now modify Header1 Header2 & Header3" & vbcrlf & _
  "values of first two records."
' ******* END CALLOUT E *******

' ******* BEGIN CALLOUT F *******
' Change the value of Header1, Header2, and Header3 in the first two records.
oRS.Movefirst
For i = 1 to 2
  oRS.Fields.Item("Header1").Value = "ChangedRec"
  oRS.Fields.Item("Header2").Value = "ChangedRec"
  oRS.Fields.Item("Header3").Value = "FindAndFilterThese"
  oRS.Update
  oRS.movenext
Next
XL.Cells.EntireColumn.AutoFit
' ******* END CALLOUT F *******

' ******* BEGIN CALLOUT G *******
' Move to the next record and store Header1's value in a variable.
oRS.movenext
ItemVal = oRS.Fields.Item("Header1").value
' ******* END CALLOUT G *******

MsgBox "Moved to the next record " & _
  "and stored Header1 value of" & vbcrlf & _
  "Row " & oRS.absoluteposition + 1 & _
  " to variable ItemVal" & vbcrlf & _
  "ItemVal = " & ItemVal & vbcrlf & _
  "Next... Find Records where 'Header1' contains the string 'ChangedRec'" & vbcrlf & _
  "and change the value to 'New Value'."

' ******* BEGIN CALLOUT H *******
' Use the Find method to find Header1 records that contain ChangedRec and changed values.
oRS.movefirst
While Not oRS.EOF
  oRS.Find("Header1 LIKE '*ChangedRec*'")
  If Not oRS.EOF Then
    Msgbox "FOUND record where Header1 contains 'ChangedRec'." & _ 
    vbcrlf & "Its value before the change is: " & oRS.Fields.Item("Header1").value
    oRS.Fields.Item("Header1").Value = "New Value "
    oRS.Update
    Msgbox "Value after the Change is: " & oRS.Fields.Item("Header1").value
    oRS.movenext
  End If
Wend
' ******* END CALLOUT H *******

Msgbox "Now Filter Recordset where Header3 " & vbcrlf & _
 "contains text string 'FindAndFilterThese'" & vbcrlf & _
 " and change the value of Header0 to 'Filtered'"

' ******* BEGIN CALLOUT I *******
oRS.Filter = "Header3 LIKE '*FindAndFilterThese*'"
While Not oRS.EOF

  Msgbox "Header0 value of Filtered recordset before change is: " & _
    oRS.Fields.Item("Header0").value

  oRS.Fields.Item("Header0").Value = "Filtered"
  oRS.Update

  Msgbox "Header0 value of Filtered Recordset after change is: " & _
    oRS.Fields.Item("Header0").value

  oRS.movenext
Wend
' ******* END CALLOUT I *******

MsgBox "Record count with Filter ON equals " & oRS.recordcount
oRS.Filter = "" 'Turn off filter
MsgBox "Record count with Filter OFF equals " & oRS.recordcount
oConn.Close
Set oConn = Nothing
Set oRS = Nothing
MsgBox "done"