Opstartroutine met controle op laatste versie

De gebruiker start de database altijd via aparte opstart_database. Via een VBA module vindt er een controle op versienummer plaats.

Nadat gebleken is dat de gebruiker niet over de laatste versie beschikt, dan wordt die eerst naar de gebruikers map gekopieerd en wordt ms-access via een Shellexecute opgestart.

Private Sub Form_Load()
'-- 2023.03.27 op site 
On Error GoTo Foutafhandeling
    
    Dim appACCESS As Access.Application, sNaamMDB As String, exclusive As Boolean
    Dim rs As DAO.Recordset, td As DAO.TableDef, sTabel As String

    Dim bVersieOphalen As Boolean, bFElokaalIsOud As Boolean
    Dim i As Integer
    Dim sMSG As String
    
    Dim MapServer As String
    Dim FileServer As String
    
    Dim MapLokaal As String
    Dim FileLokaal As String
    
    Dim VersieServer As String
    Dim VersieLokaal As String
    Dim versieNr As String
    
    Dim sGoed_01 As String, sGoed_02 As String, sGoed_03 As String
    
    Dim bTabelVersie As Boolean
    Dim sSQL As String
    SysCmd acSysCmdSetStatus, "INFO DB VERSIE 23 april 2020"
    
    Screen.MousePointer = 11

   
    '- 2014.08.31 aangepast
    
    If InStr(CurrentDb.Name, "Start_DATABASE") > 0 Then
        sOmgeving = "SSY_prod"
    End If
    MapServer = ap_PAD(1, sOmgeving)
    MapLokaal = ap_PAD(2, sOmgeving)
    
    FileServer = MapServer & ap_FILE(1, sOmgeving)
    FileLokaal = MapLokaal & ap_FILE(2, sOmgeving)
    
    If GetFileAttributes(FileServer) = -1 Then
        '-- nee FE niet op server
        MsgBox "Kan " & FileServer & " niet vinden.", vbCritical, "Database SSY"
        DoCmd.Quit
    End If
 
    If GetFileAttributes(MapLokaal) = -1 Then
        MkDir MapLokaal
    End If
        
    bVersieOphalen = False
    '----------------------------------------------------------------------------------------
    ' 1 Staat het Front-End lokaal
    If GetFileAttributes(FileLokaal) = -1 Then
        If CopyFile(FileServer, FileLokaal, -1) = -1 Then
            MsgBox "Lokaal kopiëren front-end MDE mislukt"
        Else
            sGoed_02 = "Laatste versie van de database is naar uw werkplek gekopiëerd"
            bVersieOphalen = False
        End If
    End If


    Set db = OpenDatabase(FileServer)
    Set rs = db.OpenRecordset("SELECT * FROM tbl_systeem_versie_server ORDER BY versieNr ASC")
       rs.MoveLast
       VersieServer = rs!versieNr
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
 
    sMSG = sGoed_01 & vbCrLf & sGoed_02 & vbCrLf & sGoed_03
    If Len(sMSG) > 16 Then 'íig > 6 x vbcrlf en een beetje
        MsgBox sMSG, vbInformation, "Mededeling"
    End If
    
    
    
    '-- Staat de laatste versie lokaal ?
    Set db = OpenDatabase(FileLokaal)
    bTabelVersie = False
    For Each td In db.TableDefs
        If td.Name = "tbl_systeem_versie_lokaal" Then
            bTabelVersie = True
            Exit For
        End If
    Next td
    If Not bTabelVersie Then
        bVersieOphalen = True
        GoTo VERSIEOPHALEN
    End If
    
    If bTabelVersie = True Then
        Set rs = db.OpenRecordset("SELECT * FROM tbl_systeem_versie_lokaal ORDER BY versienr asc")
        If rs.EOF And rs.BOF Then
            MsgBox "Kan versie front-end op de server niet bepalen"
            Exit Sub
        Else
            rs.MoveLast
            VersieLokaal = rs!versieNr
            DatumVersie = rs.Fields("Datum")
            sOmschrijving = Nz(rs.Fields("Omschrijving"), "geen omschrijving")
        End If
        rs.Close
    End If
    db.Close
    Set db = Nothing
    
    If VersieServer > VersieLokaal Then
        bVersieOphalen = True
        GoTo VERSIEOPHALEN
    Else
        bVersieOphalen = False
    End If
    
  
    
  
VERSIEOPHALEN:

Dim FSO As Scripting.FileSystemObject
 
    
    '-------------------------------------------------------------------------------------------------------
    '-- filelokaal = C:\USERS\..bv GastDCE  \Appdata\Roaming\Cadfiler\cadfiler_prod.accde
    If bVersieOphalen = True Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        FSO.DeleteFile FileLokaal
        If GetFileAttributes(FileLokaal) <> -1 Then
            MsgBox "Verwijderen vorige versie is mislukt", vbCritical, "START_CADFILER "
        End If
    
        MsgBox "Versie " & VersieServer & " wordt nu eerst vanaf " & MapServer & "  gekopieerd.", vbInformation, "Database SSY"
       
        If CopyFile(FileServer, FileLokaal, -1) = -1 Then
            MsgBox "Lokaal kopieren front-end MDE mislukt"
        End If
        
        bFElokaalIsOud = True
        
    End If
 
   
    Me.Repaint
    
   
     Dim lRet As Long, sParams As String, QQ As String, cmd As String
     Dim sShell As String
    
    SysCmd acSysCmdSetStatus, "Front end gaat opgestart worden."
    
    QQ = Chr$(34)
    
    Dim Pad_msAccess As String
    
    Pad_msAccess = ""
    
    
    '-- 2015.12.24 office    2016 64-bit
    Pad_msAccess = "C:\Program Files (x86)\Microsoft Office\root\Office16\msaccess.exe" 'misschien
    If GetFileAttributes(Pad_msAccess) <> -1 Then cmd = Pad_msAccess
    
    
    If cmd = "" Then
        cmd = Pad_msAccess
        'MsgBox "vertel windows svp dat een *.mde of *.mdb ook met ms-access geopend moet worden.", vbExclamation, "windows issue"
        'GoTo exit_here
    End If
    sShell = QQ & cmd & QQ & " " & QQ & FileLokaal & QQ & "  /cmd " & QQ & sOmgeving & QQ

    Call Shell(sShell, vbMaximizedFocus)
    DoCmd.Quit

exit_here:
    Screen.MousePointer = 0
    DoCmd.Quit
    Exit Sub
    
Foutafhandeling:
    MsgBox Err.Description, vbCritical, "Fout in opstart-database xxx Systems"
    Resume exit_here


End Sub