将来自oracle数据库的数据sorting到不同的工作表中

以下是从oracle数据库中取数据到excel的VBA代码。 而不是数据去一些随机工作表，我希望与collabname 301_CBCompanySync_SAP_to_HHT相关的数据被放到名为301_CBCompanySync_SAP_to_HHT的工作表中，

与协作名302_CBCustomer_SAP_to_HHT相关的数据将被放入名为“302_CBCustomer_SAP_to_HHT”..so的工作表中

我应该如何修改下面的代码

Sub Load_data() 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=xxxx" & _ ";Password=xxxxx" & _ ";Data Source=xx.xx.xx.xxx:xxxx/xxxxxx" & _ ";Provider=OraOLEDB.Oracle") Dim arrayCollabName As Variant Dim idx As Integer idx = 0 arrayCollabName = Array("301_CBCompanySync_SAP_to_HHT", "302_CBCustomer_SAP_to_HHT", "303_CustomerExclusionList_SAP_to_HHT") For idx = 0 To 2 Sheets("Sheet1").Select Sheets.Add rs.Open "select COLLABNAME,DATETIME,TOTALFLOWS,SUCCFLOWS,FAILEDFLOWS from EWS_COLLAB WHERE COLLABNAME like '" & arrayCollabName(idx) & "'", cn col = 0 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 Next cn.Close End Sub 

Answer 1

所以，希望它确定。

 Sub Load_data() 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 Dim arrayCollabName As Variant Dim idx As Integer Set cn = New ADODB.Connection Set rs = New ADODB.Recordset idx = 0 'array with all collab names arrayCollabName = Array("301_CBCompanySync_SAP_to_HHT", "302_CBCustomer_SAP_to_HHT", "303_CustomerExclusionList_SAP_to_HHT") 'connect to Database cn.Open ( _ "User ID=xxxx" & _ ";Password=xxxxx" & _ ";Data Source=xx.xx.xx.xxx:xxxx/xxxxxx" & _ ";Provider=OraOLEDB.Oracle") 'loop for inserting the Data from the SQL For idx = 0 To 2 Sheets("Sheet1").Select Sheets.Add 'Rename the new added sheet If Len(arrayCollabName(idx)) > 31 Then ActiveSheet.Name = Left(arrayCollabName(idx), 31) Else ActiveSheet.Name = arrayCollabName(idx) End If 'database query rs.Open "select COLLABNAME,DATETIME,TOTALFLOWS,SUCCFLOWS,FAILEDFLOWS from EWS_COLLAB WHERE COLLABNAME like '" & arrayCollabName(idx) & "'", cn col = 0 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 'database query with the search results closing rs.Close Next 'database connection closed cn.Close End Sub Sub deletSheets() Dim idx As Integer Application.DisplayAlerts = False For idx = 0 To ActiveWorkbook.Sheets.Count If Not ActiveSheet.Name = "Sheet1" Then ActiveWindow.SelectedSheets.Delete End If Next idx Application.DisplayAlerts = True End Sub