下面是从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 on的工作表中
我应该如何修改下面的代码
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发布于 2012-04-17 20:51:47
所以,希望没问题。
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 Subhttps://stackoverflow.com/questions/10190946
复制相似问题