VBA multiple SQL queries

[lees57]

26754

26755
Hi,
I really need a help on setting VBA code for running multiple SQL queries.

My goal is to run multiple difference queries through the customized function.
Is it possible to soft code the SQL string?
I would be super appreciated with your help..!!!

[Bob Phillips]

What do you mean by 'soft code the SQL string'? But as a rule it is better to run stored procedures/queries in the database rather than code the SQL in VBA.

[Kenneth Hobs]

Get it to work manually first. Be sure to add the reference object(s) if you are going to use early binding as you did in the attached file.

Here is an ADO UDF example:

'http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_23640071.htmlPublic
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