| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798 |
- Option Compare Database
- ' ** Access Toolbox Module **
- ' on 2017-02-28,
- ' @author: Olivier Massot
- ' V 1.0
- ' Version manager
- Public Function local_version() As Date
- local_version = DFirst("val", "[t_config]", "[parameter]='version_date'")
-
- End Function
- Public Function last_version() As Date
- last_version = DMax("version_date", "[zt_versions]", "")
-
- End Function
- Public Function up_to_date() As Boolean
- up_to_date = local_version() >= last_version()
- End Function
- Public Function installer_path() As String
- installer_path = DFirst("val", "[t_config]", "[parameter]='installer_path'")
- End Function
- Public Sub send_update_mail()
- ' ! Requires 'AT_Mail' module
- 'On Error GoTo err
- Dim version_name As String
- Dim installer_p As String
- Dim modif As String
- Dim subject As String
- Dim str As String
-
- str = " ATTENTION:" & vbNewLine & _
- vbNewLine & _
- " Votre version de l'application n'est pas à jour. " & vbNewLine & _
- "Voulez-vous qu'un mail de mise à jour vous soit envoyé?"
- If MsgBox(str, vbYesNo) = vbNo Then Exit Sub
-
- sujet = "AUTOMATIQUE - Mise à jour " & CurrentDb.Properties("AppTitle")
-
- str = "<html>" & vbCrLf & _
- "<body>" & vbCrLf & _
- "Bonjour, <br><br>" & vbCrLf
-
- 'version:
- version_name = Nz(DFirst("version_name", "zt_versions", "[version_date] Like '" & last_version() & "'"), "")
- If Len(version_name) > 0 Then
- version_name = " en version: <b>" & version_name & " (" & last_version() & ")</b><br>"
- Else
- version_name = " dans une nouvelle version."
- End If
-
- str = str & " L'application <b>" & CurrentDb.Properties("AppTitle") & "</b> est disponible " & version_name & vbCrLf
-
- 'content
- version_content = Nz(DLookup("description", "zt_versions", "[version_date] Like '" & last_version() & "'"), "")
- If Len(version_content) > 0 Then
- str = str & _
- " Les modifications suivantes ont été apportées: <br><br>" & vbCrLf & _
- " " & version_content & "<br><br>" & vbCrLf
- End If
-
- 'fin du message
- installer_p = installer_path()
- If Len(installer_p) > 0 And Dir(installer_p) <> "" Then
- installer_p = "<a href='" & installer_path() & "'>ici</a><br>"
- Else
- installer_p = " <b>(lien invalide)</b>"
- End If
-
- str = str & _
- " Pour mettre à jour, cliquez " & installer_p & "<br>" & vbCrLf & _
- "Bonne journée!" & vbCrLf & _
- "Cordialement," & vbCrLf & _
- "</body>" & vbCrLf & _
- "</html>"
-
- Call send_mail(sujet, str, current_account(), True)
-
- MsgBox "Le mail a été envoyé, vous devriez le recevoir d'ici quelques instants."
- Exit Sub
- err:
- MsgBox "Erreur: Il semble que votre application ne soit pas à jour, et impossible d'envoyer le mail de mise à jour, veuillez contacter un administrateur"
- End Sub
|
