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