'*******************************************
'* Actualiza Front End
'* AWactualDb ruta base de datos, parametros inicio
'* Referencias: DAO 3.6
'* Es necesario tener instalado Windows Scripting Host
'* Marius.
'*******************************************
Public Sub AWactualDb(rutaNewDb As String, Optional strPARAM = Null)
Dim dbs As DAO.Database
Dim strDb As String, DbVer As Single
Dim strNewDb As String, DbNewVer As Single
Dim strAccess As String, strDbName As String
Dim shellNew As Object

On Error GoTo errAWactualDb
If rutaNewDb = "" Then Exit Sub
strAccess = Application.SysCmd(acSysCmdAccessDir) & "msaccess.exe"

If Left(Application.CurrentProject.Name, 3) = "NEW" Then
    strDbName = Mid(Application.CurrentProject.Name, 4)
Else
    strDbName = Application.CurrentProject.Name
End If

rutaNewDb = rutaNewDb & "\" & strDbName
strNewDb = Application.CurrentProject.Path & "\NEW" & strDbName
strDb = Application.CurrentProject.Path & "\" & strDbName

If Left(Application.CurrentProject.Name, 3) = "NEW" Then
    MsgBox "Version actualizada.", vbInformation, "Proceso realizado"
    CopyFile strNewDb, strDb, 0
    AWbmpDB strDb
    Set shellNew = CreateObject("Wscript.Shell")
    shellNew.Run Chr(34) & strAccess & Chr(34) & " " & Chr(34) & strDb & Chr(34) & strPARAM, 3, 0
    Application.Quit acQuitSaveNone
End If

DbVer = AWversion(CurrentDb)
Set dbs = OpenDatabase(rutaNewDb, False, False)
DbNewVer = AWversion(dbs)
Set dbs = Nothing
    
If DbVer < DbNewVer Then
    If MsgBox("¿ Desea actualizar a la version " & Str(DbNewVer) & " ?", vbQuestion + vbYesNo + vbDefaultButton1, "Nueva version disponible") = vbYes Then
    CopyFile rutaNewDb, strNewDb, 0
    AWbmpDB strNewDb
    Set shellNew = CreateObject("Wscript.Shell")
    shellNew.Run Chr(34) & strAccess & Chr(34) & " " & Chr(34) & strNewDb & Chr(34) & strPARAM, 0, 0
    Application.Quit acQuitSaveNone
    End If
End If

If Dir(strNewDb) > "" Then Kill strNewDb
Exit Sub

errAWactualDb:
MsgBox Err.Description
End Sub

'* Devuelve la ruta de tablas vinculadas
Private Function AWrutaDB(Optional strTABLA = Null) As String
Dim tbl As DAO.TableDef
On Error GoTo errAWrutaDB
If IsNull(strTABLA) Then
    For Each tbl In CurrentDb.TableDefs
        If tbl.Connect > "" Then
        strTABLA = tbl.Name
        Exit For
        End If
    Next
End If
If IsNull(strTABLA) Then GoTo AWrutaDBExit

AWrutaDB = CurrentDb.TableDefs(strTABLA).Connect
AWrutaDB = Mid(AWrutaDB, InStr(AWrutaDB, "DATABASE=") + 9)
AWrutaDB = Mid(AWrutaDB, 1, InStrRev(AWrutaDB, "\") - 1)

AWrutaDBExit:
    On Error GoTo 0
    Exit Function
    
errAWrutaDB:
    MsgBox Err.Description
End Function

'* Lee / Crea el numero de version
Private Function AWversion(opOBJECT As Object, Optional opSUB = 0, Optional nVersion As Single = 1)
If opSUB = 0 Then ' read
    On Error GoTo AWversionAppend
    AWversion = opOBJECT.Properties("DbVer").Value
    GoTo AWversionExit
End If

AWversionAppend:
    On Error Resume Next
    opOBJECT.Properties.Delete ("DbVer")
    On Error GoTo errAWversion
    opOBJECT.Properties.Append opOBJECT.CreateProperty("DbVer", DB_SINGLE, nVersion)
    AWversion = nVersion

AWversionExit:
    On Error GoTo 0
    Exit Function
    
errAWversion:
    MsgBox Err.Description
End Function

'* Si no existe, crea un BMP de la aplicacion
Private Function AWbmpDB(strDbBMP)
Dim AWfnum As Integer, AWfname As String, byteBMP(65) As Byte
On Error GoTo AWbmpDBExit
AWfname = Left(strDbBMP, InStr(strDbBMP, ".")) & "bmp"
If Dir(AWfname) > "" Then Exit Function
byteBMP(0) = 66
byteBMP(1) = 77
byteBMP(2) = 102
byteBMP(10) = 62
byteBMP(14) = 40
byteBMP(18) = 1
byteBMP(22) = 1
byteBMP(26) = 1
byteBMP(28) = 1
byteBMP(34) = 4
byteBMP(38) = 196
byteBMP(39) = 14
byteBMP(42) = 196
byteBMP(43) = 14
byteBMP(46) = 2
byteBMP(58) = 255
byteBMP(59) = 255
byteBMP(60) = 255
byteBMP(62) = 128

AWfnum = FreeFile
Open AWfname For Binary As AWfnum
Put AWfnum, , byteBMP
Close AWfnum

AWbmpDBExit:
    On Error GoTo 0
End Function

Para probar este procedimiento:
- Crear una base nueva (p.e. c:\base1.mdb)
- Crear un form (p.e. formInicial) y establecerlo como furmulario de inicio en Herram./Inicio
- Copiamos las funciones en el modulo del formInicial
- En el formInicial, en el evento open:
****************************
Option Compare Database
Option Explicit
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Private Sub Form_Open(Cancel As Integer)
'... 
' iniciamos el numero de version ...
AWversion CurrentDb, 1, 1.0 
AWactualDb "c:\temp"
End Sub

****************************

- Abrimos el form para que tome el valor de la version. 
- Copiamos la base1.mdb a otra carpeta (p.e. c:\temp) 
- Abrimos la base c:\temp\base1.mdb
- Modificamos el form y cambiamos la version por 1.5
- Abrimos el form para que tome el valor de la version. 
- Abrimos la base c:\base1.mdb

****************************
Argumentos posibles del procedimiento AWactualDb :
AWactualDb "c:\temp" 
- opcionalmente podemos pasar parametros de inicio.
AWactualDb "c:\temp","/user nombreusuario" 

Argumentos posibles de la funcion AWrutaDB:
- para obtener la ruta de la primera tabla vinculada
AWrutaDB 
- para obtener la ruta de la tabla que se indique
AWrutaDB "tablaX"

Argumentos posibles de la funcion AWversion :
opOBJECT: objeto
opSUB: 0 lee version, 1 graba version
nVersion: numero de version

- para cambiar la version de la base actual
AWversion CurrentDb, 1, 1.05
- para leer la version de la base actual
AWversion CurrentDb


NOTA: Se agradecen los comentarios sobre cualquier mejora o posible error.