Outlook multiples pieces jointes?
Salut à tous,
Je suis à la recherche d'un codage qui permettrai d'envoyer un message à plusieurs destinataires en ayant des pièces jointes différentes selon les destinataires.
j'ai trouvé ce tableau excel mais il est pas fonctionnel pour des pièces jointes différentes selon destinataire.
Pourriez m'aider?
PS: j'ai ajouter des colonnes avec les chemins des pièces jointes.
Je suis débutant en codage.
Merci d'avance
Bonjour pierro44,
voici une proposition à tester:
Sub test()
Dim myTable As ListObject
Dim i As Integer
Dim Destinataire As String, Comment As String
Dim sFichier1 As String, sFichier2 As String, sFichier3 As String, sFichier4 As String
Dim oMsgApp As Object, oMsg As Object
Set myTable = ActiveSheet.ListObjects("tblBase")
Set oMsgApp = CreateObject("Outlook.Application")
For i = 1 To Range("tblBase").Rows.Count
Comment = Range("tblBase[Commentaire]")(i)
Destinataire = Range("tblBase[Mail]")(i)
sFichier1 = Range("tblBase[Fichier 1]")(i)
sFichier2 = Range("tblBase[Fichier2]")(i)
sFichier3 = Range("tblBase[Fichier3]")(i)
sFichier4 = Range("tblBase[Fichier4]")(i)
Set oMsg = oMsgApp.CreateItem(0)
With oMsg
.To = Destinataire
.Subject = "Demande DT"
.Attachments.Add sFichier1
.Attachments.Add sFichier2
.Attachments.Add sFichier3
.Attachments.Add sFichier4
.Body = "Veuillez trouver ci-joint concernant le dossier cité en référence, les pdf des CERFA et du plan de l 'emprise du chantier ainsi que le fichier XML de notre DT." & Chr(10) & Chr(13) & _
Comment & Chr(10) & Chr(13) & "Cordialement"
.Display 'Send <<======= Display permet d'afficher le message, Send l'envoie sans affichage
End With
Set oMsg = Nothing
Next i
oMsgApp.Quit
Set oMsgApp = Nothing
MsgBox "Mail envoyé"
End Sub
Salut
merci le code fonctionne à merveille , super boulot!!!!
mais par contre j'ai pas forcément 4 pièces jointes par destinataire, il peut y en avoir plus ou moins selon les cas voir aucune !
j'ai testé en laissant des cellules vide et la macro fonctionne plus
Pourriez vous regarder.
Merci !!!
Bonjour pierro44,
merci pour ton retour, voici le code adapté pour le cas où il n'y a pas de pièces jointes dans une ou plusieurs colonnes, s'il en faut plus de quatre ajoute les colonnes et les variables nécessaires.
Sub test2()
'https://forum.excel-pratique.com/viewtopic.php?f=2&t=136438
Dim myTable As ListObject
Dim i As Integer
Dim Destinataire As String, Comment As String
Dim sFichier1 As String, sFichier2 As String, sFichier3 As String, sFichier4 As String
Dim oMsgApp As Object, oMsg As Object
Set myTable = ActiveSheet.ListObjects("tblBase")
Set oMsgApp = CreateObject("Outlook.Application")
For i = 1 To Range("tblBase").Rows.Count
Comment = Range("tblBase[Commentaire]")(i)
Destinataire = Range("tblBase[Mail]")(i)
sFichier1 = Range("tblBase[Fichier 1]")(i)
sFichier2 = Range("tblBase[Fichier2]")(i)
sFichier3 = Range("tblBase[Fichier3]")(i)
sFichier4 = Range("tblBase[Fichier4]")(i)
Set oMsg = oMsgApp.CreateItem(0)
With oMsg
.To = Destinataire
.Subject = "Demande DT"
If sFichier1 <> "" Then
.Attachments.Add sFichier1
End If
If sFichier2 <> "" Then
.Attachments.Add sFichier2
End If
If sFichier3 <> "" Then
.Attachments.Add sFichier3
End If
If sFichier4 <> "" Then
.Attachments.Add sFichier4
End If
.Body = "Veuillez trouver ci-joint concernant le dossier cité en référence, les pdf des CERFA et du plan de l 'emprise du chantier ainsi que le fichier XML de notre DT." & Chr(10) & Chr(13) & _
Comment & Chr(10) & Chr(13) & "Cordialement"
.Display 'Send <<======= Display permet d'afficher le message, Send l'envoie sans affichage
End With
Set oMsg = Nothing
Next i
oMsgApp.Quit
Set oMsgApp = Nothing
MsgBox "Mail envoyé"
End Sub
Super !!! ca fonctionne nikel
je te remercie beaucoup !!!!
tu m'as bien dépanné !!!
En merci