Sub RSTest_2007_ADO()
' This sub will pull data from an external .xlsx file. The ADO object
' library reference must be loaded.
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
Dim WS As Worksheet
Dim RSCount As Integer
Dim FieldCount As Integer
Dim i, j As Integer
Dim NoRecords As Boolean
Dim FilePath As String
Dim FileName As String
Set WS = ActiveWorkbook.ActiveSheet
Set cn = New ADODB.Connection
FilePath = "C:\Test\"
FileName = "Data.xlsx"
strSQL = "SELECT * FROM [Sheet1$]"
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & FilePath & FileName & ";" & _
"Extended Properties=Excel 12.0;"
.Open
End With
Set rs = cn.Execute(strSQL)
With WS
TopRow = .Range("A20000").End(xlUp).Row
NoRecords = False
With rs
FieldCount = .Fields.Count
If Not (.BOF And .EOF) Then
NoRecords = False
.MoveFirst
While Not .EOF
.MoveNext
RSCount = RSCount + 1
Wend
Else
NoRecords = True
MsgBox ("No records in target")
Exit Sub
End If
.MoveFirst
While Not .EOF
For i = TopRow To TopRow + RSCount - 1 Step 1
For j = 1 To FieldCount Step 1
WS.Cells(i, j) = .Fields(j - 1)
Next j
.MoveNext
Next i
Wend
End With
End With