Public Sub QueryWorksheet(szSQL As String, rgStart As Range, wbWorkBook As String)
Dim rsData As ADODB.Recordset
Dim szConnect As String
On Error GoTo ErrHandler
Application.StatusBar = "Retrieving data ....."
szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & wbWorkBook & ";" & _
"Extended Properties=Excel 8.0;"
Set rsData = New ADODB.Recordset
rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rsData.EOF Then
rgStart.CopyFromRecordset rsData
Else
MsgBox "There is no records that matches the query !!", vbCritical
End If
rsData.Close
Set rsData = Nothing
Application.StatusBar = False
Exit Sub
ErrHandler:
MsgBox "Your query could not be executed, the SQL-statement is incorrect."
Set rsData = Nothing
Application.StatusBar = False
End Sub
Sub testsql()
Dim rgPlaceOutput As Range
Dim stSQLstring As String
stSQLstring = Range("B3").Text
Set rgPlaceOutput = Range("B9")
rgPlaceOutput.Resize(20000, 6).ClearContents
QueryWorksheet stSQLstring, rgPlaceOutput, ThisWorkbook.FullName
End Sub
|