Access - CAMBIAR DE DAO A ADO

Private Sub Comando5_Click()

Dim dbs As DAO.Database

Dim Qdf As DAO.QueryDef

Dim StrSQL As String

Dim StrQry As String

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