olinox14
/
openaccess


			
				
					
						
						
							123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115
							Option Compare Database

Public Sub Mail_Maj()
Dim VERSION, modif, lien As String
Dim DateVersion As Date
Dim sujet, str As String

'avertissement
lien = parametre("Lien_MAJ")
If Not Len(lien) > 0 Then Exit Sub

If MsgBox("ATTENTION:  Votre version de l'application n'est pas à jour. Voulez-vous qu'un mail de mise à jour vous soit envoyé?", vbYesNo) = vbNo Then Exit Sub

sujet = "AUTOMATIQUE - Mise à jour " & CurrentDb.Properties("AppTitle")

str = "<html>" & vbCrLf & _
          "<body>" & vbCrLf & _
             "Bonjour, <br><br>" & vbCrLf

'version:
DateVersion = DMax("Version", "ztblVersion", "")
If DateVersion > #1/1/1990# Then VERSION = " en version: <b>" & Nz(DLookup("Version_Lb", "ztblVersion", "[Version]=#" & Format(DateVersion, "mm/dd/yyyy") & "#"), "") & " (" & DateVersion & ")</b><br>"
If Not Len(VERSION) > 0 Then VERSION = " dans une nouvelle version."

str = str & " L'application <b>" & CurrentDb.Properties("AppTitle") & "</b> est disponible " & VERSION & vbCrLf

'modifs
If DateVersion > #1/1/1990# Then modif = Nz(DLookup("Modifications", "ztblVersion", "[Version]=#" & Format(DateVersion, "mm/dd/yyyy") & "#"), "")
If Len(modif) > 0 Then
 str = str & _
       " Les modifications suivantes ont été apportées: <br><br>" & vbCrLf & _
       "  " & modif & "<br><br>" & vbCrLf
End If

'fin du message
lien = "<a href='" & lien & "'>ici</a><br>"

str = str & _
             " Pour mettre à jour, cliquez " & lien & "<br>" & vbCrLf & _
             "Bonne journée!" & vbCrLf & _
          "</body>" & vbCrLf & _
      "</html>"

Call EnvoiMail(sujet, str, , True)
'l'absence de destinataire défini enverra le mail à l'utilisateur (il se l'envoie à lui-même)

MsgBox "Le mail a été envoyé, vous devriez le recevoir d'ici quelques instants."

End Sub

Public Sub EnvoiMail(ByVal sujet As String, ByVal texte As String, Optional dest As String, Optional EnvoiAuto As Boolean)
'si le destinataire n'est pas precisé, le mail est envoyé à soi-même (pour un mail de MAJ par exemple)
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Dim oAccount As Outlook.Account

Set olApp = GetObject("", "Outlook.Application")
Dim olExplorer As Outlook.Explorer
Dim html As Integer
html = 0
If Left(texte, 6) = "<html>" Then html = 1
' Créons un objet Mail qui va nous servir de base pour définir les paramètres et le contenu de notre mail

Set objMail = olApp.CreateItem(olMailItem)

'Maintenant nous allons créer un object nous permettant de nous déplacer dans les dossiers d’outlook.
Dim mpf As Outlook.MAPIFolder

'Dans quel format voulons nous notre Mail Texte Brut ou Texte Enrichi
If html = 1 Then
objMail.BodyFormat = olFormatHTML
Else
objMail.BodyFormat = olFormatRichText
End If

'Affiche le mail dans Outlook
'Sans cette ligne la fenêtre n’est pas visible
If Nz(EnvoiAuto, False) = False Then objMail.Display

'Affectation du sujet du mail
'Idéalement, vous utiliserez dans votre propre code une variable ou un paramètre via l’appel de cette procédure
objMail.Subject = sujet

'Affectation du corps du message, le Body…

If html = 1 Then
objMail.HTMLBody = texte
Else
objMail.Body = texte
End If

'Affectation du destinataire du message

If Not Len(dest) > 0 Then
 For Each oAccount In olApp.Session.Accounts
  dest = oAccount.SmtpAddress
 Next
End If

objMail.To = dest

'Affectation des destinataires en Copie ou en copie cachée
'objMail.Cc = "-@cg67.fr"
'objMail.BCC= "-@cg67.fr"

' Et voila, vous avez prérempli votre mail au sein d’outlook
' Il ne vous reste plus que de compléter éventuellement votre mail à la main et de cliquer sur Envoyer
 
'Si vous souhaitez forcer l’envoi directement depuis le code VBA, sans laisser le temps à l’utilisateur de relire le mail
' il vous suffit de faire appel à :
If Nz(EnvoiAuto, False) = True Then objMail.Send

Set olApp = Nothing
Set objMail = Nothing
End Sub