Siguiente es el código de VB para recuperar datos de oracle de base de datos a excel.

La COLLABNAME ficha de la tabla NOMBRE_TABLA tiene 20 diferentes colaboración nombres y quiero enviar los datos correspondientes a cada una colaboración en una hoja diferente a partir de la hoja1

Actualmente estoy planeando escribir el mismo código 20 veces y recuperar datos de diferentes hojas y el código que se muestra a continuación

CÓDIGO ACTUAL:

   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

Seguí el código para sólo dos COLLABNAMES

Quiero añadir un bucle que contiene COLLABNAME1, COLLABNAME2, COLLABNAME3, COLLABNAME4
…COLLABNAME20 de modo que los datos que se obtienen a 20 hojas diferentes de la tabla NOMBRE_TABLA que disminuye la longitud del código y ser la más elegante de

Gracias de antemano

InformationsquelleAutor user1292831 | 2012-03-29

2 Comentarios

  1. 2

    Acaba de crear una nueva Sub cual hace que la parte común.

    Esto no está probado el código, pero debería funcionar (o usted puede ser que necesite para corregir problemas menores).

       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

    EDICIÓN:

    Si el COLLABNAME es en ningún formato fijo, entonces usted no puede utilizar el Bucle. En ese caso sería necesario llamar a cada uno de ellos individualmente.
    Será en el formato:

    Load_data_into_sheet _SheetToFill_ , _COLLABNAME_ , cn

    por ejemplo,

       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
    • Si el COLLABNAME no está en orden, como COLLABNAME1, COLLABNAME2… y son todos diferentes, como Collab_Name1_01, Collab_NAme2_02, Collab_NAME1_NAME2…. No puedo utilizar el código para i=1 a 20 como arriba se Puede por favor decirme la modificación en el código de en caso de que
    • Añadido el código de arriba. 🙂
    • Cómo cambiar la instrucción Select código si no quiero repetir rs.Open «select COLLABNAME,DATETIME,TOTALFLOWS de TABLE_NAME DONDE to_date(DATETIME, ‘DDMMAAAA HH24:MI) ENTRE el caso cuando to_char(sysdate, ‘dd’) > 7, a continuación, trunc(sysdate-7) else trunc(sysdate,’mm’) end Y trunc(sysdate) Y COLLABNAME como ‘» & CollabName & «‘ ORDER BY DATETIME ASC», cn
    • Cuando estoy tratando de ejecutar la macro sus diciendo: no VÁLIDO O no cualificado, de REFERENCIA EN ESTA LÍNEA Private Sub Load_data_into_sheet(ws Como Hoja de cálculo, CollabName Como Cadena, cn Como ADODB.De conexión)
    • Ha añadido una referencia a la biblioteca de ado en el editor de VB?
    • He añadido Microsoft Activex Data Objects 2.8 biblioteca como referencia

  2. 0

    Si usted tiene muchos COLLABNAME y realmente quieres usar un bucle, se puede utilizar un bucle por la carga de los nombres de hoja en una matriz de cadenas, luego de recorrer.

    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

Dejar respuesta

Please enter your comment!
Please enter your name here