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

Option Compare Database
Option Explicit


'********************************************************************************************
'API. Esta declaración es necesaria para la función mc_strEjecutarAplicación.
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                        (ByVal hwnd As Long, ByVal lpOperation As String, _
                        ByVal lpFile As String, ByVal lpParameters As String, _
                        ByVal lpDirectory As String, ByVal nShowCmd As Long) _
                        As Long

Private Declare Function apiShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                        (ByVal hwnd As Long, ByVal lpOperation As String, _
                        ByVal lpFile As String, ByVal lpParameters As String, _
                        ByVal lpDirectory As String, ByVal nShowCmd As Long) _
                        As Long

'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MIN = 2            'Open Minimized
Public Const WIN_MAX = 3            'Open Maximized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
'** Fin de API para mc_strEjecutarAplicación ************************************************



Private Sub Demo_mc_strEjecutarAplicación()

'Abrir una carpeta:
'    Call mc_strEjecutarAplicación("C:\TEMP\", WIN_MAX)

'Enviar un email:
'    Call mc_strEjecutarAplicación("mailto:dash10@hotmail.com", WIN_NORMAL)

'Abrir URL:
'    Call mc_strEjecutarAplicación("http://www.mcpegasus.com", WIN_NORMAL)

'Iniciar otra aplicación de Access:
'    Call mc_strEjecutarAplicación("C:\Archivos de programa\Microsoft Office\Office\Ejemplos\Neptuno.mdb", WIN_NORMAL)

'Iniciar un programa cualquiera:
'    Call mc_strEjecutarAplicación("C:\Archivos de programa\Accesorios\Wordpad.exe", WIN_NORMAL)

End Sub

Public Function mc_strEjecutarAplicación(strRutaArchivo As String, lngModoApertura As Long) As String
'********************************************************************************************
'Actualización:     02/04/2002                                  Fecha Creación:    21/10/2001
'Autor:             Code Courtesy of Dev Ashish
'Modificación:      McPegasus
'Contacto:          mcpegasus@mcpegasus.com, www.mcpegasus.com
'
'Propósito:         Abrir un fichero(sabiendo su nombre y path) con el visor por defecto que _
                    tenga.

'Devuelve un valor True/False, dependiendo si se ha producido un error al intentar abrir.


'La sintaxis del Procedimiento o Función, consta de estos argumentos:
'Parte                          Descripción
'-------------------------------------------------------------------------------------------
'strRutaArchivo:    Requerido   Ruta completa, ver más en ejemplos en _
                                Demo_mc_strEjecutarAplicación _
lngModoApertura:    Requerido   Modo de apertura de la ventana _
                                WIN_NORMAL  = Normal _
                                WIN_MAX     = Maximizada _
                                WIN_MIN     = Minimizada.


    Dim lngResutado     As Long
    Dim strResultado    As String
    Dim varTaskID       As Variant
    
    'First try ShellExecute
    lngResutado = apiShellExecute(hWndAccessApp, vbNullString, _
            strRutaArchivo, vbNullString, vbNullString, lngModoApertura)
            
    strResultado = vbNullString
    If lngResutado > ERROR_SUCCESS Then
        lngResutado = -1
    Else
        Select Case lngResutado
            Case ERROR_NO_ASSOC:
                'Abrir el cuadro de diálogo para seleccionar una aplicación. "Abrir con..."
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & strRutaArchivo, WIN_NORMAL)
                lngResutado = (varTaskID <> 0)
                Case ERROR_OUT_OF_MEM:
                    strResultado = strResultado & "No hay Memoria/Recursos."
                Case ERROR_FILE_NOT_FOUND:
                    strResultado = strResultado & "Archivo no encontrado."
                Case ERROR_PATH_NOT_FOUND:
                    strResultado = strResultado & "Ruta no encontrada."
                Case ERROR_BAD_FORMAT:
                    strResultado = strResultado & "Formato de archivo desconocido."
                Case Else:
                    strResultado = strResultado & "Indefinido."
        End Select
        strResultado = strResultado & vbCr & vbCr & "La aplicación no se puede ejecutar."
    End If
    
    If Not strResultado = "" Then
        DoCmd.Beep
        MsgBox strResultado, vbCritical + vbOKOnly, "McPegasus informa."
        mc_strEjecutarAplicación = True
    Else
        mc_strEjecutarAplicación = False
    End If
                
End Function