Option Compare Database
Option Explicit
'McPegasus,escrito en las News
Function CreaMdb(strRutaArchivO As String)

 'En strTutaArchivo metemos el Path completo
 'del fichero MDB a convertir en MDE
 Dim accappRutaArchivo As Access.Application
            DoCmd.Beep
            '"http://www.microsoft.com/intlkb/spain/E195/9/49.asp"
            If MsgBox("¿Deseas crear un archivo .MDE de la base de datos:" & vbCr _
                    & strRutaArchivO & "?", vbYesNo, "McPegasus informa.") = vbYes Then
                'Crear una nueva instancia de Access.
                Set accappRutaArchivo = CreateObject("Access.Application")
                'Esperar un tiempo, en caso contrario no siempre funciona la acción SendKeys.
                mc_PausaCódigo 0.75
                'Las siguientes líneas simulan aceptar el nombre en el cuadro _"Nombre de archivo:", pulsar el botón "Crear MDE" y en el siguiente cuadro _
                de diálogo, el botón "Guardar".
                SendKeys strRutaArchivO & "{Enter}{Enter}"
                'Con el método RunCommand ejecutar el comando del menú incorporado de _
                barra de herramientas (Crear MDE.)
                accappRutaArchivo.DoCmd.RunCommand acCmdMakeMDEFile
                DoCmd.Beep
                MsgBox "El archivo:" & vbCr & Mid(strRutaArchivO, 1, Len(strRutaArchivO) - 4) & ".mde" & vbCr _
                    & "se ha creado con éxito." _
                    , vbInformation + vbOKOnly, "McPegasus informa."
            End If
End Function

Public Function mc_PausaCódigo(intSegundos As Double)
'Última actualización: 21/10/2001
'Función para hacer una pausa en la ejecución del código y dar tiempo a terminar a la _
tarea anteriormente encomendada.

'Parámetros, _
        intSegundos,    Una cifra que son los segundos de espera.

    Dim sngHora As Double
    'Espera los segundos especificados
    sngHora = Timer
    Do While Timer - sngHora < intSegundos
        'Cede el control de la ejecución al sistema operativo, para que este pueda procesar _
        otros eventos.
        DoEvents
    Loop

End Function



    Source: geocities.com/es/ensolva/Descargas/Documentos

               ( geocities.com/es/ensolva/Descargas)                   ( geocities.com/es/ensolva)                   ( geocities.com/es)