Option Compare Database
Option Explicit

Private Const constrOriginMDB As String = "\\Server\XXX\XXX.mdb"
Private Const constrLocalMDB As String = "C:\XXX\XXX.mdb"

Private Const CSIDL_SysFolder = &H29

Public Function StartApplication()

Dim FSO As Object, SysFolderPatch As String
Dim oShell As Object, Str1
Set oShell = CreateObject("WScript.Shell")


Set FSO = CreateObject("Scripting.FileSystemObject")
'find if local folder exists'
If Len(constrOriginMDB) > 0 Then
    CheckLocalFolders constrLocalMDB
End If

On Error Resume Next

    
If Dir(constrLocalMDB, vbNormal) = "" Then 'if file does not exist'
    FileCopy constrOriginMDB, constrLocalMDB
Else
    If HasToBeRefreshed Then 'check if there is new version on the server'
        FileCopy constrOriginMDB, constrLocalMDB
    End If
End If
    
If Err.Number > 0 And Err.Number <> 70 Then
    Beep
    MsgBox Err.Number & vbCrLf & Err.Description
End If

On Error GoTo ErrorLabel

Call shell(SysCmd(acSysCmdAccessDir) & "MSACCESS.EXE " & constrLocalMDB, vbNormalFocus)

DoCmd.Quit

Exit Function

ErrorLabel:
    DoCmd.Hourglass False
    DoCmd.Maximize
    Beep
    MsgBox "Something wrong with Database," & vbCrLf & "Ask DB developer to fix it@" & vbCrLf & _
            Err.Number & "@" & Err.Description & "@", vbCritical
    Application.Quit
End Function

Private Function CheckLocalFolders(strFilePath)
Dim strCurrPath As String
Dim strCurrFolder As String
Dim intPos As Integer

If Left$(strFilePath, 3) <> "C:\" Then
    MsgBox "Wrong Path Argument in CheckLocalFolders Function", vbCritical
    Exit Function
End If

strCurrPath = "C:\"
intPos = 3

Do Until intPos = 0
    intPos = InStr(intPos + 1, strFilePath, "\")
    If intPos > 0 Then
        strCurrPath = Left$(strFilePath, intPos - 1)
        If Dir(strCurrPath, vbDirectory) = "" Then
            MkDir strCurrPath
        End If
    End If
Loop
End Function

Private Function HasToBeRefreshed() As Boolean
Dim wrk As Workspace
Dim dbs As Database, cnt As Container
Dim doc As Document
Dim lngVersionOnServer As String
Dim lngVersionOnC As String

Const conPropertyNotFound = 3270    ' Property not found error.

On Error GoTo SetCustom_Err
    Set wrk = DBEngine.Workspaces(0)
    Set dbs = wrk.OpenDatabase(constrLocalMDB)
    Set cnt = dbs.Containers!Databases
    Set doc = cnt.Documents!UserDefined
    
    lngVersionOnC = doc.Properties("DB Version")
    
    Set dbs = wrk.OpenDatabase(constrOriginMDB)
    Set cnt = dbs.Containers!Databases
    Set doc = cnt.Documents!UserDefined

    lngVersionOnServer = doc.Properties("DB Version")

    Set doc = Nothing
    Set cnt = Nothing
    Set dbs = Nothing
    Set wrk = Nothing

    HasToBeRefreshed = (lngVersionOnServer <> lngVersionOnC)

    Exit Function

SetCustom_Err:
    Beep
    If Err = conPropertyNotFound Then
        MsgBox "There is no information of the DB Version.", vbExclamation
    Else
        MsgBox Err.Number & vbCrLf & Err.Description
    End If

    HasToBeRefreshed = False
End Function

Private Const constrOriginMDB As String = "\\server\User\Soft\XXX.mdb"


Public Function Change_Version()
Dim wrk As Workspace
Dim dbs As DataBase, cnt As Container
Dim doc As Document

    Set wrk = DBEngine.Workspaces(0)
    Set dbs = wrk.OpenDatabase(constrOriginMDB)
    Set cnt = dbs.Containers!Databases
    Set doc = cnt.Documents!UserDefined


doc.Properties("DB Version") = Left(doc.Properties("DB Version"), _
Len(doc.Properties("DB Version")) - 1) & (Val(Right(doc.Properties("DB Version"), 1)) + 1)


    Set doc = Nothing
    Set cnt = Nothing
    Set dbs = Nothing
    Set wrk = Nothing

DoCmd.Quit
End Function