Quién me puedo revisar este código Vba de exportación de Access a Excel de una consulta.

A toda la comunidad, gracias por su ayuda y dedicación en este escenario. Mi consulta va a lo siguiente, hice este código VBA para exportar consultas algunas pueden tener parámetros como otras no, y las quiero llevar a Excel a través de un formulario.

Tengo la lista ya hecha pero cuando corro solo me sale el detalle de la primera fila que son los encabezados de las columnas pero la información no sale.

Me da el nombre de la Worksheet

Entonces ya no sé que hacer en que línea me equivoqué. Muchas gracias.

Private Sub Form_Open(Cancel As Integer)
Dim oQD As QueryDef
Dim sQry As String
lstQUERIES.RowSourceType = "Value list"
lstQUERIES.RowSource = ""
'Llenar lista consultas con todas las consultas
'que inician con "indicador"
For Each oQD In CurrentDb.QueryDefs
If Left(oQD.Name, 9) = "Indicador" Then
lstQUERIES.AddItem oQD.Name
End If
Next oQD
End Sub

Private Sub lstQUERIES_AfterUpdate()
Dim oRS As DAO.Recordset, i As Long, sFormat As String
Dim oExc As Excel.Application
Dim oWB As Excel.Workbook
Dim oWS As Excel.Worksheet
'Consultas que pudieran tener parametros estas deben ser primero
With CurrentDb.QueryDefs(lstQUERIES)
'Use un for loop para establecer cada uno de los parametros
For i = 0 To .Parameters.Count - 1
.Parameters(i).Value = InputBox("Establecer parametro: " & _
.Parameters(i).Name)
Next i
'Ahora abrir el recordset
Set oRS = .OpenRecordset
If oRS.RecordCount = 0 Then
MsgBox "No hay registros en la consulta", vbInformation, "Aviso TecnoAgro": Exit Sub
End If
End With
'El resto es copia completa previa en la rutina del set
Set oExc = CreateObject("Excel.Application")
Set oWB = oExc.Workbooks.Add
Set oWS = oWB.Sheets(1)
oWS.Name = lstQUERIES.Value
Set oRS = CurrentDb.OpenRecordset(lstQUERIES)
For i = 0 To oRS.Fields.Count - 1
oWS.Cells(1, i + 1) = oRS.Fields(i).Name
Select Case oRS.Fields(i).Type
Case dbDate: sFormat = "dd/mm/yyyy"
Case dbCurrency: sFormat = "$#,##0.00"
End Select
oWS.Cells(1, i + 1).EntireColumn.NumberFormat = sFormat
Next i
oWS.Cells(2, 1).CopyFromRecordset oRS
oWS.Cells.EntireColumn.AutoFit
oWS.Cells.EntireRow.AutoFit
oExc.Visible = True
End Sub

1 respuesta

Respuesta
3

Aquí ya es un poco tarde y no he repasado en Profundidad tu código, pero mira si sustituyendo tu línea >> oWS.Cells(2, 1). CopyFromRecordset oRS

Por éstas líneas

'Llenamos la Hoja con los Datos del RecordsetClone, si es que no está vacio
If Not (oRS.EOF And oRS.BOF) Then        
        oRS.MoveLast
        oRS.MoveFirst
        oWS.Range("A2").CopyFromRecordset oRS  ' O bien tu línea
        'oWS.Cells(2, 1).CopyFromRecordset oRS
Else
    MsgBox "Por alguna razón el Recordset que intentas copiar está vacío",vbCritical, "RECORDSET VACIO"
End If

Dime por favor si te resuelve el problema, y si no ha sido así, mañana le doy una ojeada si otro usuario no te ha contestado. Un saludo >> Jacinto

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas