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
               (
geocities.com/es/ensolva/Descargas)                   (
geocities.com/es/ensolva)                   (
geocities.com/es)