Bonjour à tous,
Un frontal quel qu’il soit ne peut se mettre à jour tout seul. Pour qu’un frontal se mette à jour tout seul il faut un fichier de type « bootstrap ».
Je suis sur cette problématique depuis un moment déjà, et le hasard de la navigation dans les anneaux access m’a fait tomber sur un script incroyable. Ce script à l’origine était destiné au compactage à la demande avec relance du frontal.
J’ai sauté dessus et je l’ai adapté pour les mises à jour de frontaux. Pour utiliser le script l’auteur demande de faire figurer une URL qui affiche ses conditions de licence qui sont gratuites.
Ce qu’il y a d’original et qui la force de ce script c’est la boucle d’attente basée sur un PING et non pas un WAIT ou un SLEEP.
Ce que je propose plus bas est très simple par rapport à l’originalité de ce script. Cela peut-être adapté aux versions inférieures à 2007.
Dans le frontal une table locale « version » avec :
NumVersion (texte) : Le numéro de version pour le « versionning » du développeur
ladate (date) : La date de mise à jour On utilise la date pour effectuer le test.
NomCompletFrontalMaJ (texte) : De type i:\frontal\maj\monfrontal.accdr
Ici l’emplacement et le nom du nouveau frontal, (il peut être différent de celui de l’utilisateur) ex la mise à jour est FRT5200.accdr et l’utilisateur fait tourner FRTJEANJACQUES.accdr.
On pourra faire un formulaire de gestion des versions avant la diffusion sur le réseau.
Sur les remarques qui ont été faites sur ma précédente proposition maintenant il n’y a plus rien en dur et surtout la mise à jour est forcée, l’utilisateur n’a pas le choix même si il change le nom du frontal ou le copie quelque part.
Avant la mise à jour on fait 3 Tests
Le fichier frontal en cours d'utilisation n’est pas une source, type accdb
Présence du fichier à l’emplacement enregistré dans la table
Comparaison des dates des 2 frontaux local et distant, si c’est supérieur alors on envoi la mise à jour.
Script d'arrêt, de copie et de redémarrage
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13 'Test avant mise à jour du frontal accdb pour 2007 mdb pour les autres versions est-ce un frontal compilé ? If right(Application.CurrentProject.Name, 5) <> "accdb" Then 'Vérification de l'éxistance du fichier et contrôle de la date If VerificationMaJ <> "Aucun" Then MsgBox "Une mise à jour du frontal est disponible !" + vbCrLf + "Le programme va se fermer puis redémarrer." + vbCrLf + "Veuillez patienter", vbInformation, "Attention" Restart End If End If
Fonction de test
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
65
66
67
68
69
70
71
72
73
74
75
76 ' Licence to http://creativecommons.org/licenses/by/3.0/ Option Compare Database Option Explicit Private Const TIMEOUT = 60 Public Sub Restart(Optional Compact As Boolean = False) ' L'option Compact pour un compactage !! Dim scriptpath As String scriptpath = Application.CurrentProject.FullName & ".dbrestart.bat" If Dir(scriptpath, vbNormal) <> "" Then If DateAdd("s", TIMEOUT * 2, FileDateTime(scriptpath)) < Date Then Kill scriptpath Else Application.Quit acQuitSaveAll Exit Sub End If End If Dim s As String s = s & "SETLOCAL ENABLEDELAYEDEXPANSION" & vbCrLf s = s & "SET /a counter=0" & vbCrLf s = s & ":CHECKLOCKFILE" & vbCrLf s = s & "ping 0.0.0.255 -n 1 -w 100 > nul" & vbCrLf s = s & "SET /a counter+=1" & vbCrLf s = s & "IF ""!counter!""==""" & TIMEOUT & """ GOTO CLEANUP" & vbCrLf s = s & "IF EXIST ""%~f2.%4"" GOTO CHECKLOCKFILE" & vbCrLf If VerificationMaJ <> "Aucun" Then s = s & "COPY " & VerificationMaJ & " " & Application.CurrentProject.FullName & vbCrLf End If If Compact Then s = s & """%~f1"" ""%~f2.%3"" /compact" & vbCrLf End If s = s & "start "" "" ""%~f2.%3""" & vbCrLf s = s & ":CLEANUP" & vbCrLf s = s & "del %0" ' Enregistrement du script construit plus haut Dim intFile As Integer intFile = FreeFile() Open scriptpath For Output As #intFile Print #intFile, s Close #intFile Dim dbname As String, ext As String, lockext As String, accesspath As String Dim idx As Integer accesspath = SysCmd(acSysCmdAccessDir) & "msaccess.exe" ' Retrouve l'extension du frontal For idx = Len(CurrentProject.FullName) To 1 Step -1 If Mid(CurrentProject.FullName, idx, 1) = "." Then Exit For Next idx dbname = left(CurrentProject.FullName, idx - 1) ext = Mid(CurrentProject.FullName, idx + 1) ' En fonction du frontal on détermine l'extension du fichier de verrouillage If left(ext, 2) = "ac" Then lockext = "laccdb" Else lockext = "ldb" End If ' Appel du script s = """" & scriptpath & """ """ & accesspath & """ """ & dbname & """ " & ext & " " & lockext Shell s, vbHide ' Ferme l'appli Application.Quit acQuitSaveAll End Sub
Fonction qui récupère la date en ADO
Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 Function VerificationMaJ() As String 'Fonction de test existence si oui compare les dates 'La fonction retourne l'emplacement et le nom du nouveau fichier Dim EmplacementFrt As String Dim ladateLocal Dim ladateFrontalMaJ Dim rst As New ADODB.Recordset rst.Open "Version", CurrentProject.Connection, adOpenStatic, adLockReadOnly rst.MoveFirst ladateLocal = rst!ladate EmplacementFrt = Nz(rst!NomCompletFrontalMaJ) rst.Close: Set rst = Nothing If FichierExiste(EmplacementFrt) = True Then 'Recherche la date sur Frontal MàJ ladateFrontalMaJ = donneladate(EmplacementFrt) Else 'Le fichier de MàJ n'existe pas VerificationMaJ = "Aucun" Exit Function End If If ladateFrontalMaJ > ladateLocal Then VerificationMaJ = EmplacementFrt Else VerificationMaJ = "Aucun" End If End Function
Fonction standard de test existance d'un fichier
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15 Function donneladate(kelbase) 'Connexion au frontal et interrogation de la date Dim conn, strConnect, rs Dim leSQL As String Set conn = CreateObject("ADODB.Connection") strConnect = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & kelbase & ";Persist Security Info=False;" conn.Open strConnect leSQL = "SELECT Version.ladate FROM Version" Set rs = conn.Execute(leSQL) rs.MoveFirst donneladate = rs(0) conn.Close Set conn = Nothing End Function
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10 Function FichierExiste(leFichier As String) As Boolean ' Le fichier existe ? Dim filesys Set filesys = CreateObject("Scripting.FileSystemObject") If filesys.FileExists(leFichier) Then FichierExiste = True End If End Function
A+
je suis preneur de vos remarques afin d'améliorer cette seconde alternative
Partager