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
|
Private Sub btnGenerationMail_Click()
Dim MonOutlook As Outlook.Application
Dim MonMessage As Outlook.MailItem
Dim MonAccount As Outlook.Account
Dim MonEspace As Outlook.NameSpace
Dim RstAdMailDest, RstAdMailEnv, RstNomFichierOUT, RstRepOUT, RstTxtObjetMail, RstTxtLigne1Mail, RstTxtLigne2Mail, RstTxtLigne3Mail As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set RstAdMailEnv = db.OpenRecordset("SELECT * FROM T_Parametrage WHERE NOM = 'AdMailEnv'", dbOpenDynaset)
Set RstAdMailDest = db.OpenRecordset("SELECT * FROM T_Parametrage WHERE NOM = 'AdMailDest'", dbOpenDynaset)
Set RstNomFichierOUT = db.OpenRecordset("SELECT * FROM T_Parametrage WHERE NOM = 'NomFichierOUT '", dbOpenDynaset)
Set RstRepOUT = db.OpenRecordset("SELECT * FROM T_Parametrage WHERE NOM = 'RepOUT'", dbOpenDynaset)
Set RstTxtObjetMail = db.OpenRecordset("SELECT * FROM T_Parametrage WHERE NOM = 'TxtObjetMail'", dbOpenDynaset)
Set RstTxtLigne1Mail = db.OpenRecordset("SELECT * FROM T_Parametrage WHERE NOM = 'TxtLigne1Mail'", dbOpenDynaset)
Set RstTxtLigne2Mail = db.OpenRecordset("SELECT * FROM T_Parametrage WHERE NOM = 'TxtLigne2Mail'", dbOpenDynaset)
Set RstTxtLigne3Mail = db.OpenRecordset("SELECT * FROM T_Parametrage WHERE NOM = 'TxtLigne3Mail'", dbOpenDynaset)
'test de présence du fichier OUT
If Dir(RstRepOUT.Fields("variable").Value & "\" & RstNomFichierOUT.Fields("variable").Value, vbHidden) = "" Then
'le fichier n'existe pas (vbHidden permet de le retrouver même s'il est caché)
MsgBox "LE FICHIER " & RstNomFichierOUT.Fields("variable").Value & " N'EST PAS PRÉSENT DANS LE RÉPERTOIRE " & RstRepOUT.Fields("variable").Value & " !!"
Exit Sub
Else
' On crée une instance d'Outlook :
Set MonOutlook = New Outlook.Application
With MonOutlook
' Et on crée un élément Outlook, qui sera un message E-Mail :
' Set MonMessage = MonOutlook.CreateItem(0)
Set MonMessage = .CreateItem(olMailItem)
Set MonAccount = .GetNamespace("MAPI").Accounts(RstAdMailEnv.Fields("variable").Value)
With MonMessage
.To = RstAdMailDest.Fields("variable").Value
.CC = ""
.BCC = ""
.Subject = RstTxtObjetMail.Fields("variable").Value & " " & Format(Date, "dd/mm/yyyy")
.Body = RstTxtLigne1Mail.Fields("variable").Value & Chr(13) & RstTxtLigne2Mail.Fields("variable").Value & Chr(13) & Chr(13) & RstTxtLigne3Mail.Fields("variable").Value
.Attachments.Add RstRepOUT.Fields("variable").Value & "\" & RstNomFichierOUT.Fields("variable").Value
.SendUsingAccount = MonAccount
'.Send ' envoi directement le message
.Save ' sauvegarde le mesage dans les brouillons
End With
MsgBox "Le message a été généré dans la BAL " & RstAdMailEnv.Fields("variable").Value & Chr(13) & "Dans les brouillons", vbInformation, "Confirmation"
Set MonOutlook = Nothing ' On ferme !
End With
End If
End Sub |
Partager