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
| Private Sub CmdEnvoyer_Click()
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim Reponse As Integer
Dim objOutlook As Outlook.Application
Dim MonMessage As Object
On Error GoTo Erreur
'Assigner l'objet Outlook
Set objOutlook = New Outlook.Application
Set db = CurrentDb
Set rs = db.OpenRecordset("T_Personne")
Do Until rs.EOF
Me.IdPersonne = Nz(rs!Matricule, 0)
If Nz(rs!EMail, "") <> "" Then
DoCmd.OutputTo acOutputReport, "R_PlanningPersonne", "PDF", CurrentProject.Path & "\Planning.pdf"
Set MonMessage = objOutlook.createitem(0) 'ouvrir une structure de message1
MonMessage.To = rs!EMail
MonMessage.Subject = "Planning de la personne"
'Corps du message
MonMessage.Body = "Voici votre planning..."
'-------------------
MonMessage.Attachments.Add CurrentProject.Path & "\Planning.pdf"
MonMessage.send
Set MonMessage = Nothing
End If
rs.MoveNext
Loop
'Fermer Outlook
'Libérer la mémoire
Set objOutlook = Nothing
Set MonMessage = Nothing
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
Exit Sub
Erreur:
Select Case Err.Number
Case -2147467259 ' adresse invalide
MsgBox "Adresse e-mail invalide"
Case 2501
MsgBox Err.Number & " " & Err.Description
End Select
End Sub |
Partager