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

Rechercher des sujets similaires à "outlook multiples pieces jointes"