Bonjour tous le monde!!!

Vous allez bien par un si beau temps?!!

J'ai une question sur la macro que j'ai développé (Grâce au forum, Merci Forum ).

J'ai un dossier avec environs 500 PDF, je dois envoyer un mail par PDF inséré en PJ à un destinataire unique.

Pouvez vous me dire si mon code est adapté à ce grand nombre d'envoi et si non m'aider à l'améliorer.

Merci

Code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
Sub Envoi_Mail()
 
Dim Chemin As String
Dim Fichier As String
Dim i As Integer, j As Integer
Dim TabPJ() As String
Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier As String
 
 
'Sélection du chemin du répertoire contenant les PJ
Chemin = InputBox("Veuillez coller le chemin d'accès complet du dossier comportant les pièce jointes")
 
'Ouverture du répertoire
'Shell "C:\windows\explorer.exe " & Chemin, vbMinimizedFocus
 
ReDim Preserve TabPJ(NombreFichiers(Chemin))
 
'Boucle sur tous les types de fichiers du répertoire.
Fichier = Dir(Chemin & "\*.*")
'Utilisez la syntaxe suivante pour boucler sur tous les fichiers xls:
'Fichier = Dir(Chemin & "*.xls")
i = 1
    Do While Len(Fichier) > 0
        'écrit le résultat dans la fenêtre d'exécution (Ctrl+G).
        'MsgBox (Chemin & "\" & Fichier)
        TabPJ(i) = Chemin & "\" & Fichier
        Fichier = Dir()
        i = i + 1
    Loop
 
For j = 1 To UBound(TabPJ)
 
Set ObjOutlook = New Outlook.Application
Set oBjMail = ObjOutlook.CreateItem(olMailItem)
Nom_Fichier = TabPJ(j)
 
If Nom_Fichier = "" Then Exit Sub
'---------------------------------------------------------
     With oBjMail
       .SentOnBehalfOfName = "bbb@ccc.fr"
       .To = "aaa@mmm.fr" ' le destinataire
       .Subject = "TEST"          ' l'objet du mail
       .Body = "Test de quentin"  'le corps du mail ..son contenu
       .Attachments.Add Nom_Fichier '"C:\Data\essai.txt" ' ou Nomfichier
       '.Display  '   Ici on peut supprimer pour l'envoyer sans vérification
       .Send
    End With
    ObjOutlook.Quit
    Set oBjMail = Nothing
    Set ObjOutlook = Nothing
 
Next j
 
MsgBox ("fini")
End Sub
Function NombreFichiers(ByVal Dossier As String) As Long
    Dim FSO As Object
 
    Set FSO = CreateObject("Scripting.FileSystemObject")
    NombreFichiers = FSO.GetFolder(Dossier).Files.Count
 
    Set FSO = Nothing
End Function