將數據從oracle讀取到excel並將具有相同單元名稱的數據發送到excel中的不同工作表的代碼

Question

以下是將數據從oracle數據庫提取到excel的VB代碼。

從表TABLE_NAME的COLLABNAME選項卡有20個不同的合作名字，我想從工作表Sheet1

發送對應於每個協作，不同的紙張開始的數據目前我打算寫相同的代碼20次，取數據到不同的表和代碼如下所示

當前代碼：

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 

我繼續的代碼只有兩個COLLABNAMES

我要添加一個環含有COLLABNAME1，COLLABNAME2，COLLABNAME3，COLLABNAME4 ... COLLABNAME20以使得被取出，從這降低了碼長和更優雅表TABLE_NAME 20分不同片數據

在此先感謝

Answer 1

只需創建一個共同部分的新子。

這不是測試代碼，但應該工作（或者你可能需要糾正小問題）。

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 

編輯：

如果COLLABNAME是沒有固定的格式，那麼你可以不使用循環。在這種情況下，您需要分別呼叫每個人。 它將採用格式：

Load_data_into_sheet _SheetToFill_ , _COLLABNAME_ , cn 

例如，

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 

Answer 2

如果你有很多COLLABNAME和真的想用一個循環，你可以通過加載工作表名稱到一個字符串數組，然後通過循環使用一個循環。

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