vba 从oracle获取数据到excel并将具有相同单元格名称的数据发送到excel中不同工作表的代码
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/9922716/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Code to fetch data from oracle to excel and send the data which has same cell name to different sheets in excel
提问by user1292831
Following is the VB code to fetch data from oracle database to excel.
以下是从oracle数据库中获取数据到excel的VB代码。
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
表 TABLE_NAME 中的 COLLABNAME 选项卡有 20 个不同的协作名称，我想将与每个协作对应的数据发送到从 sheet1 开始的不同工作表
Currently I am planning to write the same code 20 times and fetch data to different sheets and the code is shown below
目前我计划编写相同的代码 20 次并将数据提取到不同的工作表，代码如下所示
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
我只保留了两个 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
我想添加一个包含 COLLABNAME1、COLLABNAME2、COLLABNAME3、COLLABNAME4 ...COLLABNAME20 的循环，以便从表 TABLE_NAME 中提取到 20 个不同工作表的数据减少代码长度并更加优雅
Thanks in advance
提前致谢
采纳答案by Pradeep Kumar
Just create a new Sub which does the common part.
只需创建一个新的 Sub 来完成公共部分。
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:
如果 COLLABNAME 没有固定格式，则不能使用 Loop。在这种情况下，您需要单独调用它们中的每一个。它将采用以下格式：
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
回答by cadvena
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.
如果您有很多 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
