10 marzo 2009

Macro Excel que Ejecuta Procedimiento Almacenado y Consulta Datos

¿Cómo narices hacíamos antes para programar sin intellisense?

Qué infierno. Ni ayudas, ni mensajes de error, ni seguridad de tipos...

En fin.. .para que luego digan que las nuevas herramientas no aumentan la productividad.

Me he tirado más de 4 horas para codificar esta tontería. Espero que a alguno le sirva.

 

Option Explicit

Private Sub cmdRun_Click()
    
    Dim DataConn, cmdSp, cmdSp2
    Dim cmdRs, pPartNumber, pMaxLevel

    ' Connection
    Set DataConn = CreateObject("ADODB.Connection")
    DataConn.Open Me.Range("B1").Value ' Valor de una celda
    
    ' Iniciamos transaccion aunque sea consulta porque
    ' usamos tablas temporales de oracle
    DataConn.BeginTrans
    
    
    ' Command 1
    Set cmdSp = CreateObject("ADODB.Command")
    cmdSp.ActiveConnection = DataConn
    cmdSp.CommandText = Me.Range("B2").Value ' Valor de una celda
    cmdSp.CommandType = 4 'adCmdStoredProc
    
    ' Parámetros
    Set p1 = cmdSp.CreateParameter("p1", 200, 1, 40)
    p1.Value = Me.Range("B4").Value ' Valor de una celda
    cmdSp.Parameters.Append p1
        
    Set p2 = cmdSp.CreateParameter("p2", 139, 1, 1)
    p2.Value = VBA.CInt(Me.Range("B5").Value) ' Valor de una celda
    cmdSp.Parameters.Append p2
            
    cmdSp.Execute
   
    ' Command 2
    Set cmdSp2 = CreateObject("ADODB.Command")
    cmdSp2.ActiveConnection = DataConn
    cmdSp2.CommandText = Me.Range("B3").Value ' Valor de una celda
    cmdSp2.CommandType = 1
    
    ' Recordset
    Set cmdRs = cmdSp2.Execute
    
    ' Borrar datos existentes
    Hoja2.Activate
    Hoja2.Cells.Value = ""
    
    ' Ejecutamos transacción porque trabajamos con tablas temporales de Oracle
    DataConn.RollbackTrans
    
    Application.ScreenUpdating = False
    RecordsetToWorkSheet cmdRs, Hoja2, 1, 1, True
    Application.ScreenUpdating = True
        
    ' Liberar recursos
    DataConn.Close
    Set cmdSp = Nothing
    Set cmdRs = Nothing
    
End Sub

' Copia Recordset a una Hoja del Libro
Sub RecordsetToWorkSheet(recordset, _
                            sheet As Worksheet, row As Long, column As Long, headers As Boolean)
    Dim lcounter As Long
    Dim c As Long
    If headers Then 'Start of the extract - put field names in Row1
        For c = column To column + recordset.Fields.Count - 1
            sheet.Cells(row, c) = recordset.Fields(c - column).Name
        Next c
    End If
    lcounter = 1
    row = row + 1
    Do Until recordset.EOF
        For c = column To column + recordset.Fields.Count - 1
            sheet.Cells(row, c) = ParseColumnValue(recordset.Fields(c - column))
        Next c
        row = row + 1
        recordset.MoveNext
        lcounter = lcounter + 1
    Loop
End Sub

' Parsea el valor de una columna.
' Necesario porque en algún caso recordColumn.Value lanza un error
Function ParseColumnValue(recordColumn) As String
    On Error Resume Next
    ParseColumnValue = recordColumn.Value
    GoTo The_End
    ParseColumnValue = "????"
The_End:
End Function
Filed under:

Comments

No Comments