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 = "" & vbCrLf & _
"" & vbCrLf & _
"Bonjour,
" & 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: " & version_name & " (" & last_version() & ")
"
Else
version_name = " dans une nouvelle version."
End If
str = str & " L'application " & CurrentDb.Properties("AppTitle") & " 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:
" & vbCrLf & _
" " & version_content & "
" & vbCrLf
End If
'fin du message
installer_p = installer_path()
If Len(installer_p) > 0 And Dir(installer_p) <> "" Then
installer_p = "ici
"
Else
installer_p = " (lien invalide)"
End If
str = str & _
" Pour mettre à jour, cliquez " & installer_p & "
" & vbCrLf & _
"Bonne journée!" & vbCrLf & _
"Cordialement," & vbCrLf & _
"" & vbCrLf & _
""
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