There are several ways to do it. The first step is to get the connection string. http://www.connectionstrings.com/
Second or even first might be to set the ADO reference if you are using early binding as you did in your code.
Once you get those two steps done, a search of this forum or general search will find many ways to do it. I have not worked with tables like that so I am not which approach is best.
QueryTables can be used.
Like your example, something from this might help. Of course there are several like that here on this forum as well.
'romperstomper, http://www.excelforum.com/excel-prog...-an-array.html
As a function:
'http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_23640071.html
Public Sub RunSQLQuery( _
ByVal SourceWorkbookPath As String, _
ByVal SQLCommand As String, _
ByRef Destination As Variant, _
Optional TablesHaveHeaders As Boolean = True, _
Optional WriteHeader As Boolean _
)
' Run SQL command against one or more tables in a workbook and write the
' resulting recordset to the range starting at the destination specified.
'
' Syntax
'
' RunSQLQuery(SourceWorkbookPath, SQLCommand, Destination, [WriteHeader])
'
' SourceWorkbookPath - The full path to the workbook in which the source tables
' reside. The workbook must have been previously saved to disk (although the
' most current version does not need to be saved to get the most recent
' data). To get the full path for an open workbook using the workbook object
' use:
' SourceWorkbookPath.Path & "\" & SourceWorkbookPath.Name
' The source workbook can be open or closed.
'
' SQLCommand - Any valid SQL command. Reference tables either by cell
' reference:
' SELECT * FROM [Sheet1$A1:C100]
' or by range name:
' SELECT * FROM [Table1]
' Field names are determined by the values in the first row of each table. To
' reference a field name use square brackets around the name:
' SELECT T1.[FieldName] FROM [Table1] AS T1
'
' Destination - Any valid range or a variant variable. If a range is passed
' then the resulting recordset is copied to the cells starting at the top
' left cell in Destination. As many cells are used as are needed. If an empty
' array is passed (UBound = -1) then the query result is returned as an
' array. Otherwise the resulting recordset is returned in Destination.
'
' TablesHaveHeaders - Pass True if the source tables have a header row. Pass
' False if not. Optional. If omitted then True is assumed. If the source
' tables do not have headers then the columns are named "F1", "F2", etc.
'
' WriteHeader - Pass True to write a header row, False to not write the
' headers. Optional. If omitted then False is assumed.
Dim RecordSet As Object ' ADODB.RecordSet
Dim ConnectionString As String
Dim Column As Long
Dim Row As Long
Dim ReturnArray As Boolean
Dim RecordCount As Long
Set RecordSet = CreateObject("ADODB.RecordSet") ' New ADODB.RecordSet
If IsArray(Destination) Then
If UBound(Destination) = -1 Then ReturnArray = True
End If
' Open the ADODB connection and run the query
ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & SourceWorkbookPath & ";" & _
"Extended Properties='Excel 8.0;HDR=" & IIf(TablesHaveHeaders, "Yes", "No") & "'"
RecordSet.Open SQLCommand, ConnectionString, 2, 1, 1 ' adOpenDynamic, adLockReadOnly, adCmdText
' Handle the results according to what was passed in Destination
If TypeName(Destination) = "Range" Then
' Copy recordset to range
Application.ScreenUpdating = False
If WriteHeader Then
For Column = 1 To RecordSet.Fields.Count
Destination.Cells(1, Column).Value = RecordSet.Fields(Column - 1).Name
Next Column
Destination.Cells(1, 1).Resize(1, RecordSet.Fields.Count).Font.Bold = True
Set Destination = Destination.Offset(1)
End If
Destination.CopyFromRecordset RecordSet
Application.ScreenUpdating = True
RecordSet.Close
ElseIf ReturnArray Then
' Return an array
RecordSet.MoveFirst
Do While Not RecordSet.EOF
RecordCount = RecordCount + 1
RecordSet.MoveNext
Loop
ReDim Destination(1 To RecordCount + IIf(WriteHeader, 1, 0), 1 To RecordSet.Fields.Count)
Row = 1
If WriteHeader Then
For Column = 1 To RecordSet.Fields.Count
Destination(Row, Column) = RecordSet.Fields(Column - 1).Name
Next Column
Row = Row + 1
End If
RecordSet.MoveFirst
Do While Not RecordSet.EOF
For Column = 1 To RecordSet.Fields.Count
Destination(Row, Column) = RecordSet.Fields(Column - 1).Value
Next Column
Row = Row + 1
RecordSet.MoveNext
Loop
RecordSet.Close
Else
' Return recordset
Set Destination = RecordSet
End If
End Sub
Sometimes something simple works:
'northwolves, http://www.mrexcel.com/forum/showthread.php?t=371840
Sub Test()
Dim sql As String
With CreateObject("ADODB.connection")
.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;imex=1;hdr=no;';Data Source=" & ThisWorkbook.FullName
sql = "SELECT f1,f3,f5,f8 FROM [sheet1$a2:h65536] where f1 in (select f1 from [sheet2$a2:a65536])"
Sheet3.[a1].CopyFromRecordset .Execute(sql)
.Close
End With
End Sub
Reply With Quote
Originally Posted by Aflatoon
