VBA multiple SQL queries

Attachment 26754

Attachment 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..!!!

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.

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:

Code:

---

'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

---