Envoi de pièces jointes ".Attachments.Add" avec liste de fichiers

**emulamateur** · 29/06/2021, 11h27

Bonjour,

Je récupère une liste de fichiers à envoyer en pièces jointes d'un mail outlook sous cette forme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

["C:\Users\pythe\Documents\Classeur2_drees2021.xlsx","C:\Users\pythe\Documents\hostsb.txt","C:\Users\pythe\Documents\fmnuMainMenu.txt"]

Par le passé, j'avais une zone de texte par fichier et utilisais la méthode ".Attachments.Add" pour chaque zone de texte ce qui était, certes, efficace, mais du tout "sexy" puisque je me retrouvais avec 8 zones de texte ...

J'ai donc voulu avoir une seule zone de texte avec l'ensemble des fichiers que je souhaite envoyer afin de "faire une boucle" sur cette liste ... mais comment faire ?

En effet, je pensais qu'il suffisais de "mettre cette liste" dans ".Attachments.Add" (un peu à la barbare

) mais cela ne fonctionne pas

...

Quelqu'un aurait-il une idée ??

Merci

**Gado2600** · 29/06/2021, 12h03

Hello,

Pourquoi ne fais-tu pas une boucle ?

Je pars de l'idée que tu as une zone de texte pour lister tous tes fichiers :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
for i = lbound(split(txt.value, ";"),1) to ubound(split(txt.value, ";"),1)
mail.add split(txt.value,";")(i)
next

J'ai fait ça à l'arrache mais c'est l'idée.

Cordialement,

**emulamateur** · 29/06/2021, 13h37

C'était justement ma piste en prenant la "," comme marqueur ou les guillements (chaque chemin de fichier étant entre guillemets) pour faire ma boucle avec ".attachments.add" ...

Mais je bute sur le codage de cette boucle ...

**emulamateur** · 29/06/2021, 15h57

J'arrive à trier ma liste :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

["C:\Users\pythe\Documents\Classeur2_drees2021.xlsx","C:\Users\pythe\Documents\hostsb.txt","C:\Users\pythe\Documents\fmnuMainMenu.txt"]

Le code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Dim liste As String
Dim listetriee() As String
liste = Me.Texte17
listetriee = Split(liste, ",")
For i = LBound(listetriee) To UBound(listetriee)
MsgBox ("résultat :" & listetriee(i))
MsgBox (Replace(Replace(listetriee(i), "[", ""), "]", "")
Next

Pour obtenir chaque fichier sous la forme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

"C:\Users\pythe\Documents\Classeur2_drees2021.xlsx"

J'ai donc essayé d'intégrer ce code à l'objet "mail" pour envoyer un courriel de la manière suivante :

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
 
With Email
 .To = Me.Texte0
 .CC = Me.Texte2
 .BCC = Me.Texte5
 .subject = Me.Texte10
 .body = Me.Texte7
Dim liste As String
Dim listetriee() As String
liste = Me.Texte17
listetriee = Split(liste, ",")
For i = LBound(listetriee) To UBound(listetriee)
.Attachments.Add Replace(Replace(Replace(listetriee(i), "[", ""), "]", ""), "\\", "\")
Next
 '.Attachments.Add (Texte17)
 '.Attachments.Add (Texte19)
 '.Attachments.Add (Texte20)
 '.Attachments.Add (Texte21)
 '.Attachments.Add (Texte30)
 .Categories = "catégorie violet"
End With

Le courriel part (ayant un "resume next au début du code) mais il n'y a AUCUNE PIECE JOINTE, je sèche toujours

**tee_grandbois** · 29/06/2021, 17h46

bonsoir,
si le texte se présente comme indiqué:

["C:\Users\pythe\Documents\Classeur2_drees2021.xlsx","C:\Users\pythe\Documents\hostsb.txt","C:\Users\pythe\Documents\fmnuMainMenu.txt"]

il faut aussi enlever les guillemets (chr(34)):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Attachments.Add Replace(Replace(Replace(Replace(listetriee(i), "[", ""), "]", ""), "\\", "\"), Chr(34), "")

**tee_grandbois** · 29/06/2021, 17h52

Le courriel part (ayant un "resume next au début du code) mais il n'y a AUCUNE PIECE JOINTE, je sèche toujours

et, du coup, tu ne vois pas les messages d'erreurs qui pourraient te mettre sur la voie, pas très malin quand on sèche

**emulamateur** · 29/06/2021, 19h24

Merci pour cette piste et j'en ai profité pour ajouter une gestion d'erreur.

J'ai une erreur 440 (erreur d'automation que je n'avais pas avec mes 5 champs de fichiers joints "pas sexys") avec le code ci-dessous :

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
Dim messagerie As Object
Dim Email As Object
  '  Dim Flds As Variant
 
    Set messagerie = CreateObject("Outlook.Application")
    Set Email = messagerie.CreateItem(0)
 
  Attach = Texte28
With Email
 .To = Me.Texte0
 .CC = Me.Texte2
 .BCC = Me.Texte5
 .subject = Me.Texte10
 .body = Me.Texte7
Dim liste As String
Dim listetriee() As String
liste = Me.Texte17
listetriee = Split(liste, ",")
For i = LBound(listetriee) To UBound(listetriee)
MsgBox Replace(Replace(Replace(Replace(listetriee(i), "[", ""), "]", ""), "\\", "\"), Chr(34), "")
'MsgBox ("résultat :" & listetriee(i))
'MsgBox Replace(Replace(Replace(listetriee(i), "[", ""), "]", ""), "\\", "\")
.Attachments.Add Replace(Replace(Replace(Replace(listetriee(i), "[", ""), "]", ""), "\\", "\"), Chr(34), "")
Next
 '.Attachments.Add (Texte17)
 '.Attachments.Add (Texte19)
 '.Attachments.Add (Texte20)
 '.Attachments.Add (Texte21)
 '.Attachments.Add (Texte30)
 .Categories = "catégorie violet"
  'MsgBox Texte50 tout le chemin et le nom du fichier
  'MsgBox Texte45 fichier tout seul
End With
  If Me.Texte45 <> "" Then
  'Call FilenameInc(Me.Texte50)
  If Forms!consultation_dossier!Texte238 = "intranet" Then
 
 
    Email.SaveAs Me.Texte50
    Email.Send
Set Email = Nothing
Set messagerie = Nothing
 
    MsgBox ("Le mail a été envoyé et sauvegardé")
    Me.Étiquette130.Visible = True
    Texte131 = Texte7
Else
Dim a As String
Dim x As Integer
Dim y As Integer
x = PosDuXieme(Forms!Menu!Texte101, "\", 3)
y = Len(Forms!Menu!Texte101) - x + 1
a = Forms!Menu!Texte85 & "" & Right(Forms!Menu!Texte101, y) & "\" & [Formulaires].[consultation_dossier].[N°dossier_gestion] & " " & [Formulaires].[consultation_dossier].[Pour] & " vs " & [Formulaires].[consultation_dossier].[Contre] & "\" & [Formulaires].[consultation_dossier].[N°dossier_gestion] & " courriers\" & [Texte45] & ".msg"
Email.SaveAs Me.Texte50
    Email.Send
Set Email = Nothing
Set messagerie = Nothing
    MsgBox ("Le mail a été envoyé et sauvegardé")
        Me.Étiquette130.Visible = True
        Texte131 = Texte7
    End If
Else: MsgBox ("Le mail n'a pas été envoyé car le nom du fichier n'est pas spécifié")
 End If

**tee_grandbois** · 29/06/2021, 19h43

J'ai une erreur 440 (erreur d'automation que je n'avais pas avec mes 5 champs de fichiers joints "pas sexys") avec le code ci-dessous :

sur quelle ligne de code survient l'erreur ?

cette ligne ne respecte pas la syntaxe VBA, [Formulaires] doit être remplacé par [Forms]:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

a = Forms!Menu!Texte85 & "" & Right(Forms!Menu!Texte101, y) & "\" & [Formulaires].[consultation_dossier].[N°dossier_gestion] & " " & [Formulaires].[consultation_dossier].[Pour] & " vs " & [Formulaires].[consultation_dossier].[Contre] & "\" & [Formulaires].[consultation_dossier].[N°dossier_gestion] & " courriers\" & [Texte45] & ".msg"

**emulamateur** · 29/06/2021, 20h59

j'ai procédé à la modifications [forms] mais cela ne change rien.

Quant à la ligne où l'erreur se produit, hormis le msgbox indiquant l'erreur 440, je n'ai aucune autre info.* pour déterminer où se trouve le probléme.

Néanmoins, mon code a fonction pendant des années et la seule modification apportées sont les suivantes :

CODE D'ORIGINE

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
.body = Me.Texte7
.Attachments.Add (Texte17)
.Attachments.Add (Texte19)
.Attachments.Add (Texte20)
.Attachments.Add (Texte21)
.Attachments.Add (Texte30)

NOUVEAU CODE

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
 .body = Me.Texte7
Dim liste As String
Dim listetriee() As String
liste = Me.Texte17
listetriee = Split(liste, ",")
For i = LBound(listetriee) To UBound(listetriee)
.Attachments.Add Replace(Replace(Replace(Replace(listetriee(i), "[", ""), "]", ""), "\\", "\"), Chr(34), "")
Next

**tee_grandbois** · 29/06/2021, 22h41

Quant à la ligne où l'erreur se produit, hormis le msgbox indiquant l'erreur 440, je n'ai aucune autre info.* pour déterminer où se trouve le probléme.

pour la connaitre, met temporairement ton instruction On Error Goto ... en commentaire

**emulamateur** · 30/06/2021, 08h20

Euréka !

voici le code qui remplace mes anciennes zone de texte :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Dim files As Variant, file As Variant
files = Split(Replace(Replace(Replace(Replace(Me.Texte17, "[", ""), "]", ""), "\\", "\"), Chr(34), ""), ",")
For Each file In files
 .Attachments.Add file
Next

En fait, le séquençage de la fonction SPLIT n'était pas bon.

Avec la formulation reprise ci-dessus, je "splitte" une chaîne de caractères en prenant comme critère la "," mais en ayant, auparavant, retiré tous les caractères qui ne me servaient à rien et ne garder "que" l'essentiel.

Ensuite, je gère chaque chemin comme une pièce jointe.

Cela fonctionne nickel!

Merci pour votre aide à tous

Envoi de pièces jointes ".Attachments.Add" avec liste de fichiers

VBA Access

Discussions similaires

Partager

Partager