Como exportar recordset agrupado a excel?

[hunter18]

Encontre un codigo que funciona bien pero cuando la sentencia SQL del recordset esta agrupado son SHAPE, APPEND y RELATE no funciona y solo exporta los encabezados, he probado de varias formas pero no doy con la solucion!!

Código [Seleccionar] Expandir


Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection

Private Sub Command1_Click()

sSQL = "SHAPE {SELECT codcat,nomcat FROM categoria} AS CABECERA " & _
"APPEND ({SELECT codprod,nomprod,codcat FROM producto} AS DETALLE " & _
"RELATE codcat TO codcat) AS DETALLE"

rs.StayInSync = False
cn.Open "Provider=MSDataShape.1;Extended Properties=Jet OLEDB:Database Password=;Persist Security Info=False;Data Source=" & App.Path & "\bd_01.mdb;Data Provider=MICROSOFT.JET.OLEDB.4.0"
     
rs.Open sSQL, cn

Set MSHFlexGrid1.DataSource = rs

End Sub

Private Sub Command2_Click()
Call Exportar_Excel(rs)
End Sub


Código [Seleccionar] Expandir


Public Function Exportar_Excel(rec As Recordset) As Boolean
    On Error GoTo errSub
    Dim Excel       As Object
    Dim Libro       As Object
    Dim Hoja        As Object
    Dim arrData     As Variant
    Dim iRec        As Long
    Dim iCol        As Integer
    Dim iRow        As Integer
       
    'Me.Enabled = False
    Screen.MousePointer = 11
    ' -- Crear los objetos para utilizar el Excel
    Set Excel = CreateObject("Excel.Application")
    Set Libro = Excel.Workbooks.Add
       
    ' -- Hacer referencia a la hoja
    Set Hoja = Libro.Worksheets(1)
       
    Excel.Visible = True: Excel.UserControl = True
    iCol = rec.Fields.Count
    For iCol = 1 To rec.Fields.Count
        Hoja.Cells(1, iCol).Value = rec.Fields(iCol - 1).Name
    Next
       
    If Val(Mid(Excel.Version, 1, InStr(1, Excel.Version, ".") - 1)) > 8 Then
        Hoja.Cells(2, 1).CopyFromRecordset rec
    Else
 
        arrData = rec.GetRows
 
        iRec = UBound(arrData, 2) + 1
           
        For iCol = 0 To rec.Fields.Count - 1
            For iRow = 0 To iRec - 1
 
                If IsDate(arrData(iCol, iRow)) Then
                    arrData(iCol, iRow) = Format(arrData(iCol, iRow))
 
                ElseIf IsArray(arrData(iCol, iRow)) Then
                    arrData(iCol, iRow) = "Array Field"
                End If
            Next iRow
        Next iCol
               
        ' -- Traspasa los datos a la hoja de Excel
        Hoja.Cells(2, 1).Resize(iRec, rec.Fields.Count).Value = GetData(arrData)
    End If
    Excel.Selection.CurrentRegion.Columns.AutoFit
    Excel.Selection.CurrentRegion.Rows.AutoFit
   
    'Hoja.Name = ""
    'Libro.saveAs App.Path & "\libro"
    'Libro.Close
    ' -- Elimina las referencias xls
    Set Hoja = Nothing
    Set Libro = Nothing
    'Excel.quit
    Set Excel = Nothing
       
    Exportar_Excel = True
    'Me.Enabled = True
    Screen.MousePointer = 0
    Exit Function
errSub:
    MsgBox Err.Description, vbCritical, "Error"
    Exportar_Excel = False
    'Me.Enabled = True
    Screen.MousePointer = 0
End Function
 
Private Function GetData(vValue As Variant) As Variant
    Dim X As Long, Y As Long, xMax As Long, yMax As Long, T As Variant
       
    xMax = UBound(vValue, 2): yMax = UBound(vValue, 1)
       
    ReDim T(xMax, yMax)
    For X = 0 To xMax
        For Y = 0 To yMax
            T(X, Y) = vValue(Y, X)
        Next Y
    Next X
       
    GetData = T
End Function



Adjunto el proyecto
http://www.megaupload.com/?d=03AHEE2U

[BlackZeroX]

Te respondo el MP aquí.

Usa SQL puro y deja el PL/SQL (Creo que es este) has las consultas por ejemplo un ´pproceso que yo haria de forma nata.

Usaria Una Conexion ADO y tomaria los recorset de cada tabla.

* 1 RecordSet Tomaría los de la tabla Categorías (Son las que menor cantidad de registros tiene no es cierte xP).
* 1 Recorset que recorrería el 1 RecordSet con una Sentencia SQL del siguiente Tipo

Código (vb) [Seleccionar] Expandir



SQLSentense = "Select * from Productos where" & RecordSet.Fields(0).Name & "='" & RecordSet.Fields(0).Value & "' "



y almaceno o plasmo estos registros en el archivo de Excel directamente!¡.

Eso seria para el primera categoría o primer registro de tu tabla Categorias

después hacemos un RecordSet.MoveNext  y continuas asta no llegar a RecordSet.EOF o era .BOF no recuerdo cual de los dos xP o hasta RecordSet.MaxRecords del RecordSet Categorias!¡.

Si tienes problemas aquí estamos!¡.

Dulce Infierno Lunar!¡.

[karmany]

Te doy una solución cutre: Extrae los datos del MSHFlexGrid  directamente como mostró BlackZeroX▓▓▒▒░░

Puedes dejar el MSHFlexGrid   no visible

[BlackZeroX]

Es mejor no depender de objetos que no sean necesarios, y que ademas te hagan usar mas ram de la necesaria, Performance!¡.

Dulce Infierno Lunar!¡.

[hunter18]

Utilizar el MSHFlexgrid pero invisible es lo mas practico mas no recomendado por el uso de ram.
Utilizo el PL/SQL por que asi se trabaja con los datareport's en fin ya vere de que forma lo utilizo, saludos.