Este ejemplo le sirve para que lo adapte a sus necesidades, contiene código VBA
Este formulario recoge todas las consultas de la base de datos y permite elegir si incluye los encabezados y si abre Excel después de exportar. Consta de un procedimiento a nivel de formulario, código en el evento Al abrir del formulario y el código del botón exporta consulta.
Archivo de Excel con encabezado
Archivo de Excel sin encabezado
CÓDIGO DEL EVENTO AL ABRIR
Private Sub Form_Open(Cancel As Integer)
Dim querys As QueryDef
For Each querys In CurrentDb.QueryDefs
If Left(querys.Name, 1) <> "~" Then
Me.cboConCodigo.AddItem (querys.Name)
End If
Next
End Sub
CÓDIGO DEL BOTÓN EXPORTAR CONSULTA
Private Sub Exportar_Consulta_Click()
On Error GoTo hay_error
'Declaramos la variable ruta
Dim Ruta As String
If IsNull(Me.cboConCodigo) Then
MsgBox "Debe seleccionar al menos una consulta", vbInformation, "Le informo.."
Me.cboConCodigo.SetFocus
Exit Sub
End If
'Asignamos la ruta de Access a la variable Ruta
Ruta = Application.CurrentProject.Path
If Me.opcAbrir = 1 And Me.opcion = 1 Then
DoCmd.OutputTo ObjectType:=acOutputQuery, ObjectName:=Me.cboConCodigo, OutputFormat:=acFormatXLSX, _
Outputfile:=Ruta & "\" & Me.cboConCodigo & ".xlsx", AutoStart:=True
ElseIf Me.opcAbrir = 1 And Me.opcion = 2 Then
DoCmd.OutputTo ObjectType:=acOutputQuery, ObjectName:=Me.cboConCodigo, OutputFormat:=acFormatXLSX, _
Outputfile:=Ruta & "\" & Me.cboConCodigo & ".xlsx"
End If
If Me.opcion = 2 Then
Call retira_fila(Ruta & "\" & Me.cboConCodigo & ".xlsx")
Shell ("Explorer " & Ruta & "\" & Me.cboConCodigo & ".xlsx"), vbMaximizedFocus
End If
MsgBox "El archivo se ha creado.", vbInformation, "Exportar Consulta"
hay_error_exit:
Exit Sub
hay_error:
MsgBox Err.Description, vbCritical, "Exportando Excel"
Resume hay_error_exit
End Sub
CÓDIGO DEL PROCEDIMIENTO RETIRA_FILA
Sub retira_fila(miquery As String)
On Error GoTo Err_Borra_fila
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim archivo As String
archivo = miquery
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open(archivo)
Set ws = wb.Sheets(1)
ws.Cells(1, 1).EntireRow.Delete
wb.Save
Err_Borra_fila_exit:
'cierra Excel
wb.Close savechanges:=False
xlApp.Quit
Set xlApp = Nothing
Set wb = Nothing
Set ws = Nothing
Exit Sub
Err_Borra_fila:
MsgBox Err.Number & ", " & Err.Description, , "Error"
Resume Err_Borra_fila_exit
End Sub
No utilice Application.FollowHyperlink, es un desastre recibirá mensajes como este.
Esto es para los que nos gusta la "Enciclopedia Británica" como dicen y para hacer las cosas bien. Si quiere el ejemplo lo puede solicitar a [email protected] favor en el asunto anotar la consulta.