将数据从oracle数据库排序到不同的表中

时间:2012-04-17 12:09:01

标签: excel excel-vba oracle10g vba

以下是将数据从oracle数据库提取到excel的VBA代码。 我希望与协作301_CBCompanySync_SAP_to_HHT相关的数据进入名为301_CBCompanySync_SAP_to_HHT且

的工作表,而不是将数据转到某个随机工作表。

与协作名称302_CBCustomer_SAP_to_HHT相关的数据将进入名为“302_CBCustomer_SAP_to_HHT”的表格。所以

如何修改以下代码

 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

1 个答案:

答案 0 :(得分: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