Pull random records from Excel and Create a new sheet

[Swi]

I would like to pull 10 random records from Excel and create a new spreadsheet. This is what I have so far. I would really like to do this all through ADO instead of creating an instance of Excel and pasting the data into it. Any suggestions?

Option Explicit
Dim conn, rs
Const adOpenStatic = 3
Const adLockReadOnly = 1
Const adCmdText = 1

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RecordSet")
conn.CursorLocation = adUseServer
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=C:\Test.xls;" & _
           "Extended Properties=""Excel 8.0;"""
rs.Open "SELECT TOP 10 * FROM [ZIP4] ORDER BY RND([ZIP4])", conn, adOpenStatic, adLockReadOnly, adCmdText

Swi

 

[Swi]

Oops. I had a few bugs in the above script but I worked them out. I am still looking though for a pure ADO solution to this.

Dim conn, rs, FolderPath, objFSO, objFile, objFolder, objFileCol, objRegEx, ExcelFileCnt
Const adOpenStatic = 3
Const adLockReadOnly = 1
Const adCmdText = 1

FolderPath = "C:\"

Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.RecordSet")
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objRegEx = CreateObject("VBScript.RegExp")
Set objFolder = objFSO.Getfolder(FolderPath)
Set objFileCol = objFolder.Files

objRegEx.Pattern = "\.xls$"
objRegEx.IgnoreCase = True
ExcelFileCnt = 0

For Each objFile In objFileCol
     If objRegEx.Test(objFile.Name) Then
       MsgBox objFile.Name
       ExcelFileCnt = ExcelFileCnt + 1
       conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                 "Data Source=" & FolderPath & objFile.Name & ";" & _
                 "Extended Properties=""Excel 8.0;"""
       rs.Open "SELECT TOP 10 * FROM [Sheet1$] ORDER BY RND([COUNT])", conn, adOpenStatic, adLockReadOnly, adCmdText
       rs.Close
       conn.Close
     End If
Next

Set objFSO = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objFileCol = Nothing
Set objRegEx = Nothing

MsgBox "Random dumps created for " & ExcelFileCnt & " Excel Files!"

Swi

 

[Swi]

Nevermind. This seems to work.

       conn.execute "SELECT TOP 10 * INTO [Excel 8.0;Database=C:\Test2.xls].[Sheet1] FROM [Sheet1$] ORDER BY RND([ZIP4])"

Swi