Search code examples
excelvbarecordset

One RecordSet with multiple Connections & SQL Querys


I have a VBA application that calls several sheets and obtains a set of data for each of them. All the information obtained must end in a single variant matrix.

I have thought of several solutions. These are:

  1. The first of them, join the recordsets to get one only.
  2. The second one would be to sequentially dump each of the RecordSets in the single matrix

Both solutions do not seem to be the solution ... This is the code for solution number 1:

Sub Test()
Dim RS01 As ADODB.Recordset
Dim RS02 As ADODB.Recordset
Dim Query As String
Dim FField As Variant
Dim Pair As Variant
Dim Pairs As Variant
Dim MFTE() As Variant
Dim Temp() As Variant
Dim Rows As Long
Dim Row As Long
Dim Column As Long
Dim Connection As String
'Looping throught the pairs
Pairs() = Array("EURAUD", "EURCAD")
For Each Pair In Pairs
    Select Case Par
        Case "EURAUD"
            Query = _
                "SELECT [FE], [HO], [AP], [MAX], [MIN], [CIE], [PAR]" & _
                "FROM [EURAUD$]" & _
                "WHERE (FE >=" & Date1 & ") and (FE <=" & Date2 & ")"
            Connection = _
                "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=File Number 1;" & _
                "Extended Properties=Excel 12.0"
            Set RS01 = New ADODB.Recordset
            RS01.Open Query, Connection, adOpenForwardOnly, adLockReadOnly
        Case "EURCAD"
            Query = _
                "SELECT [FE], [HO], [AP], [MAX], [MIN], [CIE], [PAR]" & _
                "FROM [EURCAD$]" & _
                "WHERE (FE >=" & Date1 & ") and (FE <=" & Date2 & ")"
            Connection = _
                "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=File Number 2;" & _
                "Extended Properties=Excel 12.0"
            Set RS02 = New ADODB.Recordset
            RS02.Open Query, Connection, adOpenForwardOnly, adLockOptimistic
    End Select
Next Pair
'Joining RS01 & RS02
RS01.MoveFirst
Do Until RS01.EOF
    RS02.AddNew
    For FField = 0 To RS01.Fields.Count - 1
        RS02.Fields(FField).Value = RS01.Fields(FField).Value
    Next FField
    RS02.Update
    RS01.MoveNext
Loop
'Dumping data into 1st variant Array
Do Until RS07.EOF
    Temp() = RS07.GetRows
Loop
'Transpose data into 2nd variant Array
Rows = RS07.RecordCount
ReDim MFTE(Rows, 7) As Variant
For Row = LBound(Temp, 2) To UBound(Temp, 2)
    For Column = LBound(Temp, 1) To UBound(Temp, 1)
        MFTE(Row, Column) = Temp(Column, Row)
    Next Column
Next Row
End Sub

With this solution I have some problems:

  1. The final RecordSet has a mix from the 1st and 2nd RecordSets
  2. The 1st variant array needs to be transposed

So, is there a better solution?


Solution

  • I would still recommend "CopyFromRecordset", there is some coding involved but I don't think the process will be significantly slowed down, maybe a fraction of a second