VBA - Envoi d'un nombre variable de fichiers PDF

[webmuster]

Bonjour à toutes et à tous

Une fois de plus je sollicite votre aide.
Grâce à différentes sources (dont votre généreuse communauté), j'ai élaboré le code suivant, qui permet d'envoyer, à différents collaborateurs, des fichiers hebdo PDF.

Sub envoyer()
    PDF

Dim ol As New Outlook.Application
Dim olmail As MailItem
Dim CurrFile As String

Set ol = New Outlook.Application
Set olmail = ol.CreateItem(olMailItem)
With olmail
.To = "" & Sheets("Mail").[A2] & ";" & Sheets("Mail").[A3] & ";" & Sheets("Mail").[A4] & ";" & Sheets("Mail").[A5] & ";" & Sheets("Mail").[A6] & ";" & Sheets("Mail").[A7] & ";" & Sheets("Mail").[A8] & ";" & Sheets("Mail").[A9] & ";" & Sheets("Mail").[A10] & ";" & Sheets("Mail").[A11] & ";" & Sheets("Mail").[A12] & ";" & Sheets("Mail").[A13] & ";" & Sheets("Mail").[A14] & ";" & Sheets("Mail").[A15] & ";" & Sheets("Mail").[A16] & ";" & Sheets("Mail").[A17] & ";" & Sheets("Mail").[A18] & ""
.CC = "" & Sheets("Mail").[B2] & ";" & Sheets("Mail").[B3] & ";" & Sheets("Mail").[B4] & ";" & Sheets("Mail").[B5] & ";" & Sheets("Mail").[B6] & ";" & Sheets("Mail").[B7] & ";" & Sheets("Mail").[B8] & ""
.Subject = "Résultats"
.Body = "Bonjour"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A3").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A4").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A5").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A6").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A7").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A8").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A9").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A10").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A11").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A12").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\" & Range("A13").Value & ".pdf"
.Attachments.Add "" & Range("A50").Value & "\TDB_QS_Hebdo v2-2013.xls"
.Display 'Display
'On peut switcher entre .send et .display selon que l'on veut envoyer le mail (send) ou seulement le préparer et le vérifier(display)
End With
End Sub

La valeur de la cellule A50 est, par formule

=GAUCHE(CELLULE("filename";EXTRACTION!A1);TROUVE("[";CELLULE("filename";EXTRACTION!A1))-2)

, le chemin du répertoire contenant les fichiers PDF à envoyer.
Cet outil ayant vocation à être partagé, le nombre de fichiers PDF présents dans le répertoire d'envoi (répertoire aléatoire suivant les utilisateurs, d'où la formule en A50) est variable de 5 à 11.
Mon code comportant 11 adresses de pièces jointes, la macro plante lorsque le répertoire contient moins de fichiers, cherchant des fichiers qui n'existent pas.

Comment puis-je corriger le code pour qu'il fonctionne, quelque soit le nombre de fichiers présents dans le répertoire d'envoi?
Enfin, d'une manière générale, mon code peut-il être allégé?

Bien cordialement

 

[Compte Supprimé 979]

Re : VBA - Envoi d'un nombre variable de fichiers PDF

Salut webmuster

Voici le code optimisé

Sub EnvoyerPDF()
  ' En cas de version différente d'Office
  ' mieux vaut utiliser le Late Binding
  Dim ol As Object  ' New Outlook.Application
  Dim olmail As Object  ' MailItem
  Dim Dest As String, Copie As String, Lig As Long
  ' Avec la feuille Mail, définir la liste des destinataires
  With Sheets("Mail")
    For Lig = 2 To 18
      If .Range("A" & Lig) <> "" Then
        Dest = Dest & .Range("A" & Lig) & ";"
      End If
      If Lig < 9 And .Range("B" & Lig) <> "" Then
        Copie = Copie & .Range("B" & Lig) & ";"
      End If
    Next
    ' Enlever le dernier point-virgule
    Dest = Left(Dest, Len(Dest) - 1)
    ' Enlever le dernier point-virgule
    Copie = Left(Copie, Len(Copie) - 1)
  End With
  'Set ol = New Outlook.Application
  Set ol = CreateObject("Outlook.Application")
  'Set olmail = ol.CreateItem(olMailItem)
  Set olmail = ol.CreateItem(0)
  With olmail
    .to = Dest
    .CC = Copie
    .Subject = "Résultats"
    .Body = "Bonjour"
    For Lig = 3 To 13
      If Range("A" & Lig) <> "" Then
        .Attachments.Add "" & Range("A50").Value & "\" & Range("A" & Lig).Value & ".pdf"
      End If
    Next Lig
    .Attachments.Add "" & Range("A50").Value & "\TDB_QS_Hebdo v2-2013.xls"
    .Display  'Display
    'On peut switcher entre .send et .display selon que l'on veut envoyer le mail (send) ou seulement le préparer et le vérifier(display)
  End With
End Sub

Pour ce qui est du répertoire source, je pense que l'on peut faire autrement que via une formule
Mais ne sachant pas ce que contient : EXTRACTION!A1

A+

 

[webmuster]

Re : VBA - Envoi d'un nombre variable de fichiers PDF

Merci Bruno

Toujours fidèle au poste.
Ton code fonctionne à merveille.
Bon dimanche à toi et aux "Excellents".

Cordialement