'Crea un módulo nuevo y pega este código. Nombre: basExportarEXCEL

Option Compare Database
Option Explicit

'Nombre del Módulo _
    ----------------------------------------------------------------------------------------
    'basExportarEXCEL

Private Sub Demo_mcblnExportarEXCEL()

   MsgBox mcblnExportarEXCEL("APIDespachos.xls", "qryDespachosExportarXLSSinParámetro", True)

End Sub

Public Function mcblnExportarEXCEL(strArchivoSalida As String, _
                                   strNombreQuery As String, _
                                   Optional blnAutoInicio As Boolean = True) As Boolean
                                   
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''' Fecha Creación:    01/11/2002                       '''''''''''''''''''
'''''''''''''''''''' Actualización:     01/11/2002                       '''''''''''''''''''
'''''''''''''''''''' Desarrollador:     McPegasus, www.mcpegasus.com     '''''''''''''''''''
'''''''''''''''''''' Contacto:          mcpegasus@mcpegasus.com          '''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Objetivo _
    ----------------------------------------------------------------------------------------
    'Exportar datos de una consulta a formato Excel, indicando un nombre de archivo de _
    salida.

'Retorno _
    ----------------------------------------------------------------------------------------
    'True en caso de producirse ningún error.

'Sintaxis _
    ----------------------------------------------------------------------------------------
    'Ver procedimiento Demo

'Argumento                          Descripción _
    ----------------------------------------------------------------------------------------
    'strArchivoSalida:  Requerido.  Una expresión de cadena que es solo el nombre, sin _
                                    ruta de acceso, del archivo al que se desea que salga _
                                    el objeto.
    'strNombreQuery:    Requerido.  Una expresión de cadena que es el nombre válido del _
                                    objeto consultas.
    'blnAutoInicio:     Opcional.   Usar True (–1) para iniciar inmediatamente la _
                                    aplicación basada en Microsoft Windows, con el archivo _
                                    especificado en el argumento strArchivoSalida cargado. _
                                    Si se deja en blanco este argumento, se asume el valor _
                                    predeterminado (True).
                                
'Comentarios _
    ----------------------------------------------------------------------------------------
    'Utiliza la variable pública pstrRutaBDActual.
    'Utiliza la propiedad de Base de Datos Personalizada pbdpRutaArchivosExcel.
    
    'Se requieren los Módulos   basDeclararyEstablecerVariablesPúblicas y _
                                basPropiedadesBaseDatos respectivamente.
                                
    'Tiene asociación con el formulario frmValoresPredeterminados, pero no imprescindible _
    su contenido para el correcto funcionamiento de esta función.
    
                                   
On Error GoTo Err_CapturarError

    Dim Rs              As Recordset
    Dim strRutaSalida   As String

    'Comprobar si la propiedad pbdpRutaArchivosExcel tiene valor o existe.
    If Not mc_FichaPersonalizar("pbdpRutaArchivosExcel", pstrRutaBDActual) = "" Then
        'Establecer la propiedad personalizada a la variable.
        strRutaSalida = mc_FichaPersonalizar("pbdpRutaArchivosExcel", pstrRutaBDActual)
        'Comprobar que existe la ruta en el H.D.
        If Dir(strRutaSalida, vbDirectory) = "" Then
            'En caso de no existir la ruta eliminarla también de la pbdpRutaArchivosExcel.
            Call mc_FichaPersonalizar("pbdpRutaArchivosExcel", pstrRutaBDActual, dbText, Null)
            strRutaSalida = ""
        End If
    Else
        strRutaSalida = ""
    End If

    If strRutaSalida = "" Then
        'No exite la propiedad, crearla.
        DoCmd.Beep
        MsgBox "No hay ninguna Ruta Predeterminada donde alojar el archivo " _
            & strArchivoSalida & vbCr & vbCr _
            & "Para establecera ir a Valores Predeterminados." _
            , vbExclamation + vbOKOnly, "McPegasus informa."
    Else
        Set Rs = CurrentDb.QueryDefs(strNombreQuery).OpenRecordset(dbOpenSnapshot)
        
        strRutaSalida = strRutaSalida & strArchivoSalida
        
        'Comprobar si hay registros.
        If Rs.EOF Then
            DoCmd.Beep
            MsgBox "La opción seleccionada, no tiene registros." _
                , vbCritical + vbOKOnly, "McPegasus informa."
        Else
            DoCmd.OutputTo acOutputQuery, strNombreQuery, acFormatXLS, strRutaSalida, blnAutoInicio
        End If
    End If

    mcblnExportarEXCEL = True
    
Salida:
    Rs.Close                'Cerrar el Conjunto de Registros.
    Set Rs = Nothing        'Liberar la memoria.
    
SalidaII:
    Exit Function

Err_CapturarError:
    Select Case Err.Number
        Case 91
            Resume SalidaII
        Case 2302           'El archivo destino del XLS está abierto.
            DoCmd.Beep
            MsgBox Err.Description, vbExclamation + vbOKOnly, "McPegasus informa."
        Case Else
            'Cazar todos aquellos errores inesperados.
            MsgBox Err.Number & " " & Err.Description
    End Select
    Resume Salida           'Salida a otro procedimiento.

End Function