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
| Sub Outlook_Click()
Dim rst As DAO.Recordset
Dim strMessageType As String
Dim strTitre As String
Dim strMsg As String
Dim AQui As String
strTitre = "Echéance ATU {NomATU} pour {InitpatNOM}/{InitpatPRE} - Rappel"
strMessageType = "Bonjour Docteur {Medecin}," _
& vbCrLf & vbCrLf _
& "L'ATU n°{NumeroATU} de {NomATU} pour le patient {InitpatNOM}/{InitpatPRE} arrive à échéance le {EcheanceATU}. " _
& vbCrLf & vbCrLf & "Veuillez trouver ci-joint un formulaire à compléter et à nous retourner en cas de demande de renouvellement " & vbCrLf _
& vbCrLf & vbCrLf & "Merci de préciser la tolérance et l'efficacité du médicament" _
& vbCrLf & vbCrLf & "Cordialement," _
' Initialisation
strSQL = "SELECT * FROM [AlerteRelance]"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
With rst
While Not rst.EOF
' Construire un message personnalisé
strTitre = Replace(strTitre, "{NomATU}", rst("NomATU"))
strTitre = Replace(strTitre, "{InitpatNOM}", rst("InitpatNOM"))
strTitre = Replace(strTitre, "{InitpatPRE}", rst("InitpatPRE"))
strMsg = Replace(strMessageType, "{Medecin}", rst("Medecin"))
strMsg = Replace(strMsg, "{NomATU}", rst("NomATU"))
strMsg = Replace(strMsg, "{InitpatNOM}", rst("InitpatNOM"))
strMsg = Replace(strMsg, "{InitpatPRE}", rst("InitpatPRE"))
strMsg = Replace(strMsg, "{NumeroATU}", rst("NumeroATU"))
strMsg = Replace(strMsg, "{EcheanceATU}", rst("EcheanceATU"))
AQui = rst!mail
'commande l'envoie du mail
Envoie_Message_dadou5821 strTitre, strMsg, AQui
rst.MoveNext
Wend
End With
' Fermeture de la session Outlook et désallocation des objets
rst.Close
Set rst = Nothing
End Sub
Private Sub Envoie_Message_dadou5821(LeTitre As String, LeMessage As String, Destinataire As String)
Dim MonOutlook As Object 'New Outlook.Application
Dim MonMessage As Object 'Outlook.MailItem
Set MonOutlook = New Outlook.Application 'avec reference outlook
'Set MonOutlook = CreateObject("Outlook.Application") 'sans reference outlook
Set MonMessage = MonOutlook.CreateItem(olMailItem)
'Remplissage de l'objet MailItem
With MonMessage
.To = Destinataire
.Subject = LeTitre
.Body = LeMessage
End With
'voir le mail
MonMessage .Display
'Expédier le mail
' MonMessage.Send
' Fermeture de la session Outlook et désallocation des objets
Set MonOutlook = Nothing
MsgBox "Relances envoyées !", vbInformation, "Base ATU"
End Sub |
Partager