Opstartroutine met controle op laatste versie
Versiebeheer stap 2 van 2
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