1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
| Public Function fTest_Version() As Boolean
'compare la version du prog (dernière ligne de la table version) avec la version indiquée dans la table "T_version_a_jour" de la base data
Dim Version_En_Cours As String
Dim Status As Integer
Dim Version_Mini As String
Dim Num1 As Double
Dim Num2 As Double
On Error GoTo fTest_Version_Err
fTest_Version = False
Set Rs_Upa = CurrentDb.OpenRecordset("T_version_a_jour", dbOpenDynaset)
Rs_Upa.MoveLast
Rs_Upa.MoveFirst
If Rs_Upa.RecordCount <> 1 Then
GoTo fTest_Version_Err
End If
Version_En_Cours = Rs_Upa("version")
Status = Rs_Upa("Etat")
Version_Mini = Rs_Upa("Version min")
Set Rs_Upa = CurrentDb.OpenRecordset("T_version", dbOpenDynaset)
Rs_Upa.MoveLast
If CDbl(fExtractBeforeFirst(Version_En_Cours, ".") & "," & fExtractAfterFirst(Version_En_Cours, ".")) >= CDbl(fExtractBeforeFirst(Rs_Upa("Version"), ".") & "," & fExtractAfterFirst(Rs_Upa("Version"), ".")) Then
Num1 = CDbl(fExtractBeforeFirst(Version_Mini, ".") & "," & fExtractAfterFirst(Version_Mini, "."))
Num2 = CDbl(fExtractBeforeFirst(Rs_Upa("Version"), ".") & "," & fExtractAfterFirst(Rs_Upa("Version"), "."))
If Num1 <= Num2 Then
Select Case Status
'1 => aucune influence; 2 => MAJ conseillée; 3 MAJ impératif
Case 1
Case 2
fMsg "Votre version de la base de données est Périmée.", "Veuillez la mettre à jour rapidement", 0
GoTo fTest_Version_Exit
Case 3
fMsg "Votre version de la base de données est Périmée.", "La mise à jour est impérative. Contactez l'administrateur pour connaitre la marche à suivre", 2
DoCmd.RunMacro "Quitter"
Case Else
End Select
Else
MsgBox "Votre version de la base de données est Périmée." & vbCrLf & "La mise à jour est impérative. Contactez l'administrateur pour connaitre la marche à suivre", vbCritical + vbOKOnly, "Attention"
DoCmd.RunMacro "Quitter"
End If
End If
fTest_Version_Exit:
fTest_Version = True
Set Rs_Upa = Nothing
Exit Function
fTest_Version_Err:
Set Rs_Upa = Nothing
fTest_Version = False
fError Err.Number, Err.Description, "fTest_Version"
End Function |
Partager