Code to fetch data from oracle to excel and send the data which has same cell name to different sheets in excel

Question

Following is the VB code to fetch data from oracle database to excel.

The COLLABNAME tab from table TABLE_NAME has 20 different collaboration names and I want to send the data corresponding to each collaboration to a different sheet starting from sheet1

Currently I am planning to write the same code 20 times and fetch data to different sheets and the code is shown below

CURRENT CODE:

   Sub Load_data()
        Sheets("Sheet1").Select
        Dim cn As ADODB.Connection
        Dim rs As ADODB.Recordset
        Dim col As Integer
        Dim row As Integer
        Dim Query As String
        Dim mtxData As Variant


        Set cn = New ADODB.Connection
        Set rs = New ADODB.Recordset

     cn.Open ( _
    "User ID=USERID" & _
    ";Password=PASSWORD" & _
    ";Data Source=xx.xx.xx.xxx:xxxx/xxxx" & _
    ";Provider=OraOLEDB.Oracle")


    rs.Open "select COLLABNAME,DATETIME,TOTALFLOWS from TABLE_NAME WHERE  to_date(DATETIME, 'DDMMYYYY HH24:MI') BETWEEN  case when to_char(sysdate, 'dd') > 7 then trunc(sysdate-7) else trunc(sysdate,'mm') end AND trunc(sysdate) AND COLLABNAME like 'COLLABNAME1' ORDER BY DATETIME ASC", cn
    With Sheet1
            col = 0
             'First Row: names of columns
            Do While col < rs.Fields.Count
                .Cells(1, col + 1) = rs.Fields(col).Name
                col = col + 1
            Loop


            mtxData = Application.Transpose(rs.GetRows)
            .Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData




        End With
        rs.Close

  rs.Open "select COLLABNAME,DATETIME,TOTALFLOWS from TABLE_NAME WHERE  to_date(DATETIME, 'DDMMYYYY HH24:MI') BETWEEN  case when to_char(sysdate, 'dd') > 7 then trunc(sysdate-7) else trunc(sysdate,'mm') end AND trunc(sysdate) AND COLLABNAME like 'COLLABNAME2' ORDER BY DATETIME ASC", cn
    With Sheet2
            col = 0
             'First Row: names of columns
            Do While col < rs.Fields.Count
                .Cells(1, col + 1) = rs.Fields(col).Name
                col = col + 1
            Loop


            mtxData = Application.Transpose(rs.GetRows)
            .Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData




        End With
        rs.Close
    End Sub

I just kept the code for only two COLLABNAMES

I want to add a loop which contains COLLABNAME1, COLLABNAME2, COLLABNAME3, COLLABNAME4 ...COLLABNAME20 so that the data that is fetched to 20 different sheets from the table TABLE_NAME which decreases the code length and be more elegant

Thanks in advance

Answer 1

If you have many COLLABNAME and really want to use a loop, you can use a loop by loading the sheet names into a string array, then looping through.

Dim strArrNames(1 to 20) as string
strArrNames = array("A", "B", ..."T")Dim i as Long

For i = 1 To 20
Load_data_into_sheet Sheets("Sheet" & i), strArrNames(i), cn
Next

Answer 2

Just create a new Sub which does the common part.

This is not tested code, but should work (or you might need to correct minor problems).

   Sub Load_data()
        Dim cn As ADODB.Connection
        Set cn = New ADODB.Connection

     cn.Open ( _
    "User ID=USERID" & _
    ";Password=PASSWORD" & _
    ";Data Source=xx.xx.xx.xxx:xxxx/xxxx" & _
    ";Provider=OraOLEDB.Oracle")

        Dim i as Long
        For i = 1 To 20
            Load_data_into_sheet Sheets("Sheet" & i), "COLLABNAME" & i, cn
        Next

        cn.close

    End Sub

   Private Sub Load_data_into_sheet(ws as WorkSheet, CollabName as String, cn as ADODB.Connection)
        ws.Select
        Dim rs As ADODB.Recordset
        Dim col As Integer
        Dim row As Integer
        Dim Query As String
        Dim mtxData As Variant


        Set rs = New ADODB.Recordset

    rs.Open "select COLLABNAME,DATETIME,TOTALFLOWS from TABLE_NAME WHERE  to_date(DATETIME, 'DDMMYYYY HH24:MI') BETWEEN  case when to_char(sysdate, 'dd') > 7 then trunc(sysdate-7) else trunc(sysdate,'mm') end AND trunc(sysdate) AND COLLABNAME like '" & CollabName & "' ORDER BY DATETIME ASC", cn
    With ws
            col = 0
             'First Row: names of columns
            Do While col < rs.Fields.Count
                .Cells(1, col + 1) = rs.Fields(col).Name
                col = col + 1
            Loop


            mtxData = Application.Transpose(rs.GetRows)
            .Range("A2").Resize(UBound(mtxData, 1) - LBound(mtxData, 1) + 1, UBound(mtxData, 2) - LBound(mtxData, 2) + 1) = mtxData




        End With
        rs.Close

    End Sub

EDIT:

If the COLLABNAME is in no fixed format, then you can't use the Loop. In that case you would need to call each one of them individually. It will be in the format:

Load_data_into_sheet _SheetToFill_ , _COLLABNAME_ , cn

e.g.

   Sub Load_data()
        Dim cn As ADODB.Connection
        Set cn = New ADODB.Connection

     cn.Open ( _
    "User ID=USERID" & _
    ";Password=PASSWORD" & _
    ";Data Source=xx.xx.xx.xxx:xxxx/xxxx" & _
    ";Provider=OraOLEDB.Oracle")

    Load_data_into_sheet Sheets("Sheet1"), "COLLABNAME1_01", cn
    Load_data_into_sheet Sheets("Sheet2"), "Collab_NAme2_02", cn
    Load_data_into_sheet Sheets("Sheet3"), "Collab_NAME1_NAME2", cn
    ' -- more statements goes here --

        cn.close

    End Sub