Para hacer esa operación sigue el proceso que te comento.
En el Formulario pones un Botón que puedes llamar como quieras, pero en el Código yo lo he llamado >> BtnExportListaAExcel
Copia el Procedimiento en el Módulo del Formulario y no te olvides de Activar el Procedimiento de Evento.
En un Modulo Estandar copia las variables que te comento y la Función.
'En un Botón del Formulario que he llamado BtnExportListaAExcel
Private Sub BtnExportListaAExcel_Click()
Dim dbs As DAO.Database
Dim Qdf As DAO.QueryDef
Dim StrSQL As String
Dim StrQry As String
Di
Dim RutaExport As String, NombExcel As String, NombFichero As String
StrSQL = Me.Lista0.RowSource 'Nombre de la Consulta capturada como RowSorce del Cuadro de Lista. En éste caso el ListBox se llama Lista0
StrQry = "QryTemporal" 'Nombre de la Consulta que se crea con el CreateQry de abajo
RutaExport = CurrentProject.Path & "\Export\" 'Export será una carpeta que cuelga de la que está la BBD (Se puede cambiar)
NombExcel = "ExcelTemp" & Format(Now(), "yymmddhhnn") 'ExcelTem es el comienzo del Nombre del FicheroExcel que obtendremos. y el Format...para detectar Fecha y hora
NombFichero = RutaExport & NombExcel & ".xlsx" 'NombFichero es la Ruta completa que se necesita. Aquí por ejemplo Obtenemos >> "C:\DirectorisBBDS\Export\ExcelTemp1904301524.xlsx"
'Sondeo si por alguna maniobra se ha quedado creada y sin Borrar la Consulta >> "QryTemporal" -----
ObjetoDestino = "QryTemporal"
Call ExisteObjeto(ObjetoDestino)
If Existe = True And EsConsulta = True Then 'En principio no debe existir porque se borra al Exportar, pero por si acaso
DoCmd.DeleteObject acQuery, StrQry
Else
Set dbs = CurrentDb
Set Qdf = dbs.CreateQueryDef(StrQry, StrSQL)
'Aegurar que la Consulta tiene Registros
If Nz(DCount("*","QryTemporal"),0) > 0 Then 'Si la Consulta tiene Registros seguimos el Proceso
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, StrQry, NombFichero, True
MsgBox "El Fichero de Excel generado es: " & NombFichero, vbInformation, "EXCEL GENERADO"
Else
MsgBox "La lista de valores no puede estar vacía. Asegura que tiene valores", vbCritical, "FALTAN DATOS"
End If
DoCmd.DeleteObject acQuery, StrQry 'Elimino la Consulta Temporal
Set dbs = Nothing
Set Qdf = Nothing
End If
End Sub
'Para poner en un Modulo Estandar. Váldrá en otros usos de ver si existe una Consulta o Tabla
'Declarar éstas variables Publicas
Public Existe As Boolean
Public EsConsulta As Boolean
Public EsTabla As Boolean
Function ExisteObjeto(NombreObjeto)
Existe = False
EsConsulta = False
EsTabla = False
For Each Objeto In CurrentDb.QueryDefs
If NombreObjeto = LCase(Objeto.Name) Then
Existe = True
EsConsulta = True
Exit For
End If
Next
If Not Existe Then
EsConsulta = False
For Each Objeto In CurrentDb.TableDefs
If NombreObjeto = LCase(Objeto.Name) Then
Existe = True
EsTabla = True
Exit For
End If
Next
End If
End Function ' ExisteObjeto
En el conjunto se puede aligerar de líneas de Código, pero he preferido seguir un paso a paso completo, para que se vea el Proceso. El código está comentado y no debería representar ningún inconveniente al aplicarlo, pero en caso de ser así me comentas. Saludos >> Jacinto
Hola, buenas tardes! He copiado el código y todo marcha bien hasta que aprieto el botón... En la primera instancia que lo aprieto, no hace nada, es un botón "bobo"A la segunda que lo aprieto, sucede estohttps://ibb.co/1m4sr2V y luego de depurar marca la siguiente lineahttps://ibb.co/KwQb3tf ¿Podrían ayudarme? - Santiago Cuba