Questions sur : Envoie de Mail Automatique en vba
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 :mrgreen:).
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:
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 |
