Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 VBA envoyer un mail outlook avec une pièce jointe

Sarah03

XLDnaute Nouveau
Bonjour

Je suis assez désespérée à vrai dire car je ne connais rien au code et je n'arrive pas à trouver une solution malgré les nombreux tutos sur internet, j'ai un code pour envoyer des mails imbriquant des données différentes selon chaque destinataire qui fonctionne bien et j'aurais aimé ajouter dans celui-ci la possibilité de mettre les pièces jointes automatiquement pour ne pas avoir à le faire pour les 95 mails (pièces jointes qui sont toutes différentes).

Voici ci-dessous le code de base avec en rouge la partie qui me pose problème, vous auriez une solution svp ?

Sub email()

Dim x As Byte

monNumero = Range("A2").Value

Set ws = Worksheets("Liste mails")
ws.Select

For compteur = 2 To 171 Step 1
monNumroActuel = Cells(compteur, 1)
If monNumero = monNumroActuel Then

If Cells(compteur, 5) = "a" Then
leSujet = Cells(compteur, 2)
mesAA = mesAA & ";" & Cells(compteur, 3)
pour = Cells(compteur, 3)
lecorp = " "

ElseIf Cells(compteur, 5) = "cc" Then
mesCC = mesCC & ";" & Cells(compteur, 4)
End If

Else
Set leOutlook = CreateObject("Outlook.Application")
monNumero = monNumroActuel
With leOutlook.CreateItem(0)
.Subject = leSujet
.To = mesAA
.Body = lecorp
.cc = mesCC
.display

If contenu = "" Then contenu = "vide"
modifier = MsgBox(contenu & vbCr & "Voulez vous choisir un fichier à joindre ?", vbYesNo, "Fichiers paramétrés")
If modifier = vbYes Then
For i = 0 To 9
If i > 0 Then encore = MsgBox("un autre ?", vbYesNo)
quest:
If encore <> vbNo Then
PJ = InputBox("Emplacement du fichier joint au PUBLIPOSTAGE?", "Paramétrage du PUBLIPOSTAGE pour la session", publipostagePJ(i))



End With

mesCC = ""
mesAA = ""
If Cells(compteur, 5) = "a" Then

leSujet = Cells(compteur, 2)
mesAA = mesAA & ";" & Cells(compteur, 3)
lecorp = " "

ElseIf Cells(compteur, 5) = "cc" Then

mesCC = mesCC & ";" & Cells(compteur, 4)
End If


End If


Next

Set leOutlook = Nothing

End Sub

Merci d'avance pour votre aide !
 

Discussions similaires

Réponses
4
Affichages
450
Réponses
7
Affichages
684
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…