Envoie de différentes pièce jointes selon le destinatire

Fermé
dup27 Messages postés 31 Date d'inscription jeudi 26 décembre 2013 Statut Membre Dernière intervention 19 décembre 2020 - Modifié le 29 mars 2019 à 16:32
Bonjour,

J'ai un code VBA qui me permet d'envoyer un courriel différent pour chaque destinataire.

J'ai dans ce code une pièce jointe que je joins à tout le monde.

Par contre, je voudrais aussi ajouter une pièce jointe unique selon le destinataire. Je souhaiterais que la pièce jointe s'ajoute automatiquement au courriel, le nom de la pièce jointe pourrait par exemple être le même que le sujet du courriel.

Pour l'instant mon code VBA me crée tous mes courriels en brouillons et je vais ajouter une à une les pièces jointes.

Je vous laisse mon code VBA que j'utilise présentement.

Merci d'avance!

Sub EnvoiMail()
  Dim ListeDest()
  Dim ListeComment()
  Dim ListeSubject()
  Dim i As Long
  Dim oMsgApp As Object
  Dim oMsg As Object
  Dim sListeDest As String
  Dim sFichier As String
  
  sFichier = Application.GetOpenFilename(, , "Sélectionner le fichier à envoyer")
  If sFichier = "" Then
    MsgBox "Aucun fichier sélectionné, opération annulée"
    Exit Sub
  End If
  
  Set oMsgApp = CreateObject("Outlook.Application")
  
  ListeDest() = Range("tblBase[Courriel]")
  ListeComment() = Range("tblBase[Commentaire]")
  ListeSubject() = Range("tblBase[Sujet]")
  
  
  For i = LBound(ListeDest(), 1) To UBound(ListeDest(), 1)
    Set oMsg = oMsgApp.CreateItem(0)
    With oMsg
      .To = ListeDest(i, 1)
      .Attachments.Add sFichier
      .Subject = ListeSubject(i, 1)
      .Body = "Madame, Monsieur," & Chr(10) & Chr(13) & Chr(10) & Chr(13) & _
        ListeComment(i, 1) & Chr(10) & Chr(13) & Chr(10) & Chr(13) & "Cordialement," & Chr(10) & "Direction des Ressources Humaines, des Communications et des Affaires Juridiques" & Chr(10) & "Montréal" & Chr(10) & " rue Bélanger Est" & Chr(10) & "Montréal (Québec) H1T 1C2" & Chr(10) 
    End With
    Set oMsg = Nothing
  Next
  
  oMsgApp.Quit
  Set oMsgApp = Nothing
  MsgBox "Courriel enregistré dans les brouillons, ne pas oublier d'ajouter l'avis de nomination et d'utiliser le client lourd d'Outlook"
End Sub