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 ....." 
     'Set up the connection string to excel against  wbWorkbook
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _ 
    "Data Source=" & wbWorkBook & ";" & _ 
    "Extended Properties=Excel 8.0;" 
     
    Set rsData = New ADODB.Recordset 
     'Run the query as adCmdText
    rsData.Open szSQL, szConnect, adOpenForwardOnly, adLockReadOnly, adCmdText 
     
     'Check if data is returned
    If Not rsData.EOF Then 
         'if the recordset contains data put them on the worksheet
        rgStart.CopyFromRecordset rsData 
    Else 
        MsgBox "There is no records that matches the query !!", vbCritical 
    End If 
     'Close connection
    rsData.Close 
     'Clean up and get out
    Set rsData = Nothing 
    Application.StatusBar = False 
    Exit Sub 
ErrHandler: 
     'an error occured in the SQL-statement
    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 'first cell for the output of the query
    Dim stSQLstring As String 'text of the cell containing the SQL statement
    stSQLstring = Range("B3").Text 
    Set rgPlaceOutput = Range("B9") 
     'clear the outputarea
    rgPlaceOutput.Resize(20000, 6).ClearContents 
     'Submit the querycell and the outputarea to the sub QueryWorksheet
     'including the full path to the workbook.
    QueryWorksheet stSQLstring, rgPlaceOutput, ThisWorkbook.FullName 
     
End Sub