Outlook multiples pieces jointes?

Y compris Power BI, Power Query et toute autre question en lien avec Excel
p
pierro44
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 12 février 2020
Version d'Excel : 2010

Message par pierro44 » 13 février 2020, 13:13

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
Mail_Automatique-avec EXcel.xlsm
(19.95 Kio) Téléchargé 4 fois
Avatar du membre
Sequoyah
Membre habitué
Membre habitué
Messages : 137
Appréciations reçues : 15
Inscrit le : 25 juin 2017
Version d'Excel : Office 365 32 bit

Message par Sequoyah » 13 février 2020, 21:33

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
p
pierro44
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 12 février 2020
Version d'Excel : 2010

Message par pierro44 » 14 février 2020, 08:56

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 !!!
Avatar du membre
Sequoyah
Membre habitué
Membre habitué
Messages : 137
Appréciations reçues : 15
Inscrit le : 25 juin 2017
Version d'Excel : Office 365 32 bit

Message par Sequoyah » 14 février 2020, 11:05

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
p
pierro44
Nouveau venu
Nouveau venu
Messages : 3
Inscrit le : 12 février 2020
Version d'Excel : 2010

Message par pierro44 » 14 février 2020, 13:08

Super !!! ca fonctionne nikel

je te remercie beaucoup !!!!

tu m'as bien dépanné !!!

En merci
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message