Re : email auto et publipostage
bonjour j'ai trouver ce fichier
j'espére que ca aide
MAIL_FACTURE - 1
Option Explicit
Sub SendEmail()
'Utilise la liaison anticipée
'Requiert une référence à la bibliothèque d'objets Outlook
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim motperso, EmailAddr, EmailAddrCC, CurFile, FACTURE, FACTURE_PDF_File, Msg, Subj, sNomXL, destinataire As String
Dim message0, message1, message2, message3, message4, message5, message6, message7, message8, message9, message10, message11, message12, message13, message14, message15, message16, message17 As St
ring
Dim MsgX, Title
On Error GoTo attention_erreur
motperso = Sheets("-CHOIX-").Range("B16")
EmailAddrCC = Sheets("-CHOIX-").Range("B19")
Sheets("BdD_AAM").Select
'Crée l'objet Outlook
Set OutlookApp = New Outlook.Application
'Parcours en boucle les lignes
Dim reponse
reponse = MsgBox(" Pièces jointes ou pas dans contenu mail ?", vbYesNo, "Demande de confirmation")
'*******************************************************************************************************
Dim FACTURE_PDF
FACTURE_PDF = MsgBox(" Générer PDF facture ou pas ?", vbYesNo, "Demande de confirmation")
'*******************************************************************************************************
For Each cell In Columns("A").Cells.SpecialCells(xlCellTypeConstants)
'Obtenir les données
message0 = cell.Offset(0, 0).Value 'X
message1 = cell.Offset(0, 1).Value 'CLEF PRIMAIRE
message2 = cell.Offset(0, 2).Value 'FACTURE
message3 = cell.Offset(0, 3).Value 'DESTINATAIRE
message4 = cell.Offset(0, 4).Value 'NOM
message5 = cell.Offset(0, 5).Value 'PRENOM
message6 = cell.Offset(0, 6).Value 'E-MAIL
message7 = cell.Offset(0, 7).Value 'ADRESSE
message8 = cell.Offset(0, 8).Value 'CODE POSTAL
message9 = cell.Offset(0, 9).Value 'VILLE
message10 = cell.Offset(0, 10).Value 'TEL
message11 = cell.Offset(0, 11).Value 'Qté_Prod_1
message12 = cell.Offset(0, 12).Value 'Qté_Prod_2
message13 = cell.Offset(0, 13).Value 'Qté_Prod_3
message14 = cell.Offset(0, 14).Value 'Qté_Prod_4
message15 = cell.Offset(0, 15).Value 'Qté_Prod_5
message16 = cell.Offset(0, 16).Value 'commentaire
message17 = cell.Offset(0, 17).Value 'FACTURE impression PDF OUI
EmailAddr = message6 'e mail
If cell.Value Like "*x*" Then
'Composer le message
Subj = "Facture " & message2 & "_" & Format(Now, " dd/mm/yyyy") & " ."
message2 = cell.Offset(0, 2).Value 'FACTURE
'Composer le message
Msg = "Bonjour " & vbCrLf & vbCrLf
Msg = Msg & "Ci-joint la facture " & message2 & " à la date du " & Format(Now, " dd/mm/yyyy") & "" & vbCrLf
Msg = Msg & "Commentaire : " & message16 & " " & vbCrLf
Msg = Msg & vbCrLf
Msg = Msg & "Cordialement" & vbCrLf
Msg = Msg & "Alexandre ADAM" & vbCrLf
Msg = Msg & "Responsable maîtrise.excel.com" & vbCrLf
Msg = Msg & vbCrLfMAIL_FACTURE - 2
'Msg = Msg & "PS : ce mail est généré de manière automatique." & vbCrLf
Dim test
If message17 = "OUI" And FACTURE_PDF = 6 Then
Sheets("FACTURE").Select
Sheets("FACTURE").Range("J6").Value = message2 'FACTURE
Sheets("FACTURE").Range("D11").Value = message3 'DESTINATAIRE
Sheets("FACTURE").Range("C12").Value = message4 'NOM
Sheets("FACTURE").Range("E12").Value = message5 'PRENOM
Sheets("FACTURE").Range("C13").Value = message7 'ADRESSE
Sheets("FACTURE").Range("C14").Value = message9 'CODE_POSTAL
Sheets("FACTURE").Range("D14").Value = message9 'VILLE
Sheets("FACTURE").Range("C15").Value = message6 'E-MAIL
Sheets("FACTURE").Range("E15").Value = message10 'TEL
FACTURE_PDF_File = "FACTURE_PDF" & "_" & message3 & "_" & message2 & ".pdf"
Sheets("FACTURE").Range("J6").Value = message2 'FACTURE
Sheets("FACTURE").Range("D11").Value = message3 'DESTINATAIRE
Sheets("FACTURE").Range("C12").Value = message4 'NOM
Sheets("FACTURE").Range("E12").Value = message5 'PRENOM
Sheets("FACTURE").Range("C13").Value = message7 'ADRESSE
Sheets("FACTURE").Range("C14").Value = message9 'CODE_POSTAL
Sheets("FACTURE").Range("D14").Value = message9 'VILLE
Sheets("FACTURE").Range("C15").Value = message6 'E-MAIL
Sheets("FACTURE").Range("E15").Value = message10 'TEL
ThisWorkbook.ActiveSheet.Copy
'Pièce jointe APPAREMMENT PDF
Application.DisplayAlerts = False
With ActiveWorkbook
Dim sRep As String 'Répertoire de sauvegarde
Dim sFilename As String 'Nom du fichier
sRep = ThisWorkbook.path & "\" 'Répertoire de sauvegarde (si non spécifié, répertoire actif par défaut)
sFilename = FACTURE_PDF_File & message3 & "_" & message2 'Nom du fichier
sFilename = Left(sFilename, InStr(1, sFilename, ".")) & "pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sRep & sFilename, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
Application.DisplayAlerts = True
End If
If reponse = 6 Then
'Pièce jointe EXCEL
Sheets("FACTURE").Select
CurFile = message3 & "_TEST_" & message2 & ".xls"
ThisWorkbook.ActiveSheet.Copy
Application.DisplayAlerts = False
With ActiveWorkbook
fichier = CurFile '& ".xls" 'FileExtStr
.SaveAs Filename:=ThisWorkbook.path & "\" & CurFile
.Close
End With
Application.DisplayAlerts = True
End If
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr
.CC = EmailAddrCC
.Subject = Subj
.Body = MsgMAIL_FACTURE - 3
If message17 = "OUI" And FACTURE_PDF = 6 Then .Attachments.Add ThisWorkbook.path & "\" & sFilename
If reponse = 6 Then .Attachments.Add ThisWorkbook.path & "\" & CurFile
.Display
'.Send
End With
End If
Next
Application.DisplayAlerts = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = False
Exit Sub
attention_erreur:
MsgX = "Nom de l'erreur 😛ROBLEME ENVOI MAIL FACTURE GENERIQUE " & Err.Description ' Définit le message.
Title = " MESSAGE D'ERREUR !!!" ' Définit le titre.
MsgBox MsgX, vbCritical, Title
End Sub
