Comment Inserer PJ avec Mail
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonjour, j'explique mon problème.
Je n'arrive pas à insérer la ou les pièces jointes dans le mails et de voir si cela fonctionne.
La macro est dans "Archiver" car le mail doit être archivé avant d'être envoyé
La ou les pièces jointes sont de tous les extension de fichier
Et si il n'y a pas de pièce jointe "Alerter par Continuer Yes/No" et continuer si "Oui" sinon sélectionner un ou plusieurs fichiers.
Voici le code:
Sub Envoi_Mail()
Dim MaMessagerie As Outlook.Application
Dim MonMessage As Object
Dim PieceJointe As Variant, PieceJointe2 As Variant
Dim Sujet As String, LeDestinataire As String, Msg As String, Réponse As String
On Error GoTo Erratum
' ¤¤ Vérification si Outlook est ouvert ¤¤
Set MaMessagerie = GetObject(, "Outlook.Application")
If (err.Number <> 0) Then ' ....................Si Outlook n'est pas ouvert, une instance est ouverte
err.Clear
Set MaMessagerie = CreateObject("Outlook.Application")
Else ' .........................................Si Outlook est ouvert, l'instance existante est utilisée
Set MaMessagerie = GetObject("Outlook.Application")
MaMessagerie.Visible = True
End If
On Error Resume Next
Set MaMessagerie = New Outlook.Application
Set MonMessage = MaMessagerie.CreateItem(0)
Set MonMessage = MaMessagerie.CreateItem(olMailItem)
'MaMessagerie.Session.Logon ' ..................Est-ce nécessaire !?
'PieceJointe2 = PieceJointe
Réponse = MsgBox("Vous êtes sur le point d'envoyer un Email" & Chr(10) & _
"Voulez-vous continuer?", vbYesNo + vbExclamation, "Email")
If Réponse = vbYes Then
PieceJointe = ThisWorkbook.Path & "\" & ThisWorkbook.Name ' En attendant avant de le changer
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' .....Extraction des données
Sujet = TextBox4.Value '..................................Objet
LeDestinataire = TextBox3.Value ' .........................Destinataire référentiel
' .....Composition du message
Msg = TextBox5.Value & vbLf & vbLf ' ..................Corps du message
Msg = Msg & TextBox6.Value & vbLf & vbLf ' ............Formule de droit
Msg = Msg & "Fait à " & TextBox7.Value & vbLf & ", le " & TextBox8.Value & vbLf & vbLf ' Lieu et Date
Msg = Msg & "Veuillez agréer, " & TextBox9.Value & ", l'expression de mes sentiments respectueux." & vbLf & vbLf
Msg = Msg & TextBox10.Value
' .....Création de l'élément de courrier et envoi
PieceJointe = UserForm6.LabelPieceJointe.Caption ' .........Pièce Jointe
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
If TextBox3.Value = "" Or TextBox4.Value = "" Then
MsgBox "Vous devez choisir un nom et saisir un titre !"
Exit Sub
TextBox3.SetFocus
End If
On Error GoTo erreur
LabelPieceJointe.Caption = PieceJointe & "; " & PieceJointe2 & "; "
With MonMessage
If LabelPieceJointe.Caption = "" Then
.To = LeDestinataire ' ........................Destinataire
.CC = Me.TextBox3.Value ' .....................Adresse Mail
.Subject = Sujet '............................Objet
.Body = Msg ' .................................Corps du message
.OriginatorDeliveryReportRequested = False ' ..Recevoir un rapport de remise
.ReadReceiptRequested = True ' ................Confirmation de lecture
Application.Wait Now + TimeValue("00:00:03") ' Pause de 3 seçonde
.Display ' ....................................Aperçu du Mail avant envoi
DoEvents
'.Send: SendKeys "^{ENTER}" 'SendKeys "^v", True
Else
.To = LeDestinataire ' ...Destinataire
.CC = Me.TextBox3.Value ' Liste des adresse Mail
.Subject = Sujet '.......Objet
.Body = Msg ' ............Corps du message
.Attachments.Add ActiveWorkbook.Path & "\" & PieceJointe ' & PieceJointe2 ' Attache le fichier au mail
'.Attachments.Add ActiveWorkbook.Path & "\" & PieceJointe2 ' .............Attache le fichier au mail
.OriginatorDeliveryReportRequested = True ' .............................Recevoir un rapport de remise
.ReadReceiptRequested = True ' ..........................................Confirmation de lecture
Application.Wait Now + TimeValue("00:00:03") ' ..........................Pause de 3 seçonde
.Display ' ..............................................................Aperçu du Mail avant envoi
DoEvents
'.Send: SendKeys "^{ENTER}" 'SendKeys "^v", True
End If
ThisWorkbook.Save
erreur:
Set MaMessagerie = Nothing
Set MonMessage = Nothing
On Error GoTo 0
err.Clear
End With
MsgBox "Message envoyé", vbInformation, "MESSAGE NOTIFICATION"
If Réponse = vbNo Then Exit Sub
End If
Exit Sub
Erratum:
MsgBox "Erreur : " & err.Number & vbLf & err.Description
End Sub
Fichier Joint :
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonsoir
Je ne comprends pas voici ce qu'il m'affiche :
et voici le code :
Sub Envoi_Mail()
Dim MaMessagerie As Outlook.Application
Dim MonMessage As Object
Dim PieceJointe As Variant, PieceJointe2 As Variant
Dim Sujet As String, LeDestinataire As String, Msg As String, Réponse As String
On Error GoTo Erratum
' ¤¤ Vérification si Outlook est ouvert ¤¤
Set MaMessagerie = GetObject(, "Outlook.Application")
If (err.Number <> 0) Then ' .Si Outlook n'est pas ouvert, une instance est ouverte
err.Clear
Set MaMessagerie = CreateObject("Outlook.Application")
Else ' Si Outlook est ouvert, l'instance existante est utilisée
'Set MaMessagerie = GetObject("Outlook.Application")
MaMessagerie.Visible = True
End If
On Error Resume Next
Set MaMessagerie = New Outlook.Application
Set MonMessage = MaMessagerie.CreateItem(0)
Set MonMessage = MaMessagerie.CreateItem(olMailItem)
'MaMessagerie.Session.Logon ' ..................Est-ce nécessaire !?
'PieceJointe2 = PieceJointe
Réponse = MsgBox("Vous êtes sur le point d'envoyer un Email" & Chr(10) & _
"Voulez-vous continuer?", vbYesNo + vbExclamation, "Email")
If Réponse = vbYes Then
With UserForm6
PieceJointe = ThisWorkbook.Path & "\" & ThisWorkbook.Name ' En attendant avant de le changer
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' .....Extraction des données
Sujet = .TextBox4.Value '.................................Objet
LeDestinataire = .TextBox3.Value ' ...............Destinataire référentiel
' .....Composition du message
Msg = .TextBox5.Value & vbLf & vbLf ' .................Corps du message
Msg = Msg & .TextBox6.Value & vbLf & vbLf ' ...........Formule de droit
Msg = Msg & "Fait à " & .TextBox7.Value & vbLf & ", le " & .TextBox8.Value & vbLf & vbLf ' Lieu et Date
Msg = Msg & "Veuillez agréer, " & .TextBox9.Value & ", l'expression de mes sentiments respectueux." & vbLf & vbLf
Msg = Msg & .TextBox10.Value
' .....Création de l'élément de courrier et envoi
PieceJointe = .LabelPieceJointe.Caption ' ...................Pièce Jointe
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
If .TextBox3.Value = "" Or .TextBox4.Value = "" Then
MsgBox "Vous devez choisir un nom et saisir un titre !"
Exit Sub
.TextBox3.SetFocus
End If
On Error GoTo erreur
.LabelPieceJointe.Caption = PieceJointe & "; " & PieceJointe2 & "; "
With MonMessage
If UserForm6.LabelPieceJointe.Caption = "" Then
.To = LeDestinataire ' ........................Destinataire
' erreur trop de correspondant car le destinataire a la même valeur
'.CC = .TextBox3.Value ' .......................Adresse Mail
.Subject = Sujet '............................Objet
.Body = Msg ' .................................Corps du message
.OriginatorDeliveryReportRequested = False ' ..Recevoir un rapport de remise
.ReadReceiptRequested = True ' ................Confirmation de lecture
Application.Wait Now + TimeValue("00:00:03") ' Pause de 3 seçonde
.Display ' ....................................Aperçu du Mail avant envoi
DoEvents
'.Send: SendKeys "^{ENTER}" 'SendKeys "^v", True
Else
.To = LeDestinataire ' ...Destinataire
.CC = UserForm6.TextBox3.Value ' Liste des adresse Mail
.Subject = Sujet '.......Objet
.Body = Msg ' ............Corps du message
.Attachments.Add ActiveWorkbook.Path & "\" & PieceJointe ' & PieceJointe2 ' Attache le fichier au mail
'.Attachments.Add ActiveWorkbook.Path & "\" & PieceJointe2 ' Attache le fichier au mail
.OriginatorDeliveryReportRequested = True ' ................Recevoir un rapport de remise
.ReadReceiptRequested = True ' .............................Confirmation de lecture
Application.Wait Now + TimeValue("00:00:03") ' .............Pause de 3 seçonde
.Display ' .................................................Aperçu du Mail avant envoi
DoEvents
'.Send: SendKeys "^{ENTER}" 'SendKeys "^v", True
End If
ThisWorkbook.Save
erreur:
Set MaMessagerie = Nothing
Set MonMessage = Nothing
On Error GoTo 0
err.Clear
End With
MsgBox "Message envoyé", vbInformation, "MESSAGE NOTIFICATION"
End With
If Réponse = vbNo Then Exit Sub
End If
Exit Sub
Erratum:
MsgBox "Erreur : " & err.Number & vbLf & err.Description
End Sub
et le mail de part pas
Bonjour,
Oh là là c'est bien compliqué ce code !!
Le mail ne part pas car il n'y a pas .send
Voici un code plus simple à partir duquel tu peux broder
Option Explicit
Sub envoi()
Dim messagerie As Object
Dim email As Object
Dim nompdf As String
On Error GoTo erreur
nompdf = Environ("Temp") & "\" & "fichier test"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=nompdf & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set messagerie = CreateObject("Outlook.Application")
Set email = messagerie.CreateItem(0)
With email
.to = [destinataire]
.Subject = [titre]
.body = "Veuillez trouver en pièce jointe ..."
.ReadReceiptRequested = True
.Attachments.Add nompdf & ".pdf"
.display
End With
Set email = Nothing
Set messagerie = Nothing
Kill Environ("Temp") & "\" & "fichier test" & ".pdf"
Exit Sub
erreur:
MsgBox "Erreur : " & Err.Number & vbLf & Err.Description
End Sub
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonsoir, oups je n'avais pas vu
.send
Je suis reparti de cela:
'**** Correspond au programme d'éxécution "Créer un Mail" ****
Sub ExempleCréer1MailaRemplir() ' ................................Exemple
' Envoie du mail pour intégration
Dim MaMessagerie As Object ' .................................Déclaration de la variable Messagerie
Dim MonMessage As Object ' ...................................Déclaration de la variable Message
Dim PieceJointe As String ' ..................................Déclération de la variable Pièce Jointe
On Error GoTo Erratum
PieceJointe = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Set MaMessagerie = CreateObject("Outlook.Application")
' MaMessagerie.Session.Logon
Set MonMessage = MaMessagerie.CreateItem(0)
On Error Resume Next
With MonMessage
.To ' ....................................................Destinataire
.CC ' ....................................................Liste des adresse Mail
.Subject '...............................................Objet
.Body ' ..................................................Corps du message
.Attachments.Add PieceJointe ' ............................Pièce Jointe
.OriginatorDeliveryReportRequested = True ' ..............Recevoir un rapport de remise
.ReadReceiptRequested = True ' ...........................Confirmation de lecture
.GetInspector.CommandBars.Item("Insert").Controls("Signature").Controls(1).Execute
Application.Wait Now + TimeValue("00:00:03") ' ...........Pause de 3 seçonde
.Display ' ...............................................Aperçu du Mail avant envoi
DoEvents
.Send ': SendKeys "^{ENTER}"
End With
On Error GoTo 0
Set MonMessage = Nothing
Set MaMessagerie = Nothing
Exit Sub
Erratum:
MsgBox "Erreur : " & Err.Number & vbLf & Err.Description
End Sub
1. Mais je souhaiterai faire ouvrir outlook avant d'envoyer le mail afin de valider exécution
2. Ensuite y insérer plusieurs pièces jointes
3. Avertir qu'il n'y pas de PJ et demander de continuer si oui on continue, si non alors on recommence
4. avant de sortir archiver.
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Et le code doit s'insérer dedans
'**** Correspond au programme du CommandButton "Envoyer et Archiver" ****
Private Sub CommandButton2_Click()
LeTexte = TextBox5
LeTexte = Application.WorksheetFunction.Substitute(LeTexte, vbCrLf, Chr(10))
Signature = TextBox10
Signature = Application.WorksheetFunction.Substitute(Signature, vbCrLf, Chr(10))
Set WsC = Sheets("Feuil6")
With WsC
.Range("C16").Value = LeTexte ' .............................Texte
.Range("C14").Value = "Objet :" ' ...........................Texte
.Range("C11").Value = "Pièce Jointe :" ' ....................Texte
.Range("I47").Value = "Signature" ' .........................Texte
.Range("D14").Value = TextBox4.Value ' ......................Objet
.Range("C7").Value = "Le " & TextBox2.Value ' ...............Date
.Range("E3").Value = TextBox11.Value ' ......................Autre mail
.Range("H6").Value = "A l'attention de " & TextBox3.Value ' Destinataire
.Range("C5").Value = TextBox1.Value ' .......................Ville de l'éxpéditeur
.Range("H6").Value = Label_Nom.Caption ' ....................Nom
.Range("H7").Value = Label_Adresse.Caption ' ................Adresse
.Range("H8").Value = Label_CodePostal.Caption ' .............CP
.Range("H9").Value = Label_Ville.Caption ' ..................Ville
.Range("D11").Value = LabelPieceJointe.Caption ' ............Chemin de la pièce jointe
.Range("C40").Value = TextBox6.Value ' ......................Formule de droit
.Range("C42").Value = "Fait à " & TextBox7.Value ' ..........Lieu
.Range("E42").Value = ", le " & TextBox8.Value ' ............Date
.Range("D45").Value = "Veuillez agréer, " & TextBox9.Value & ", l'expression de mes sentiments respectueux."
.Range("H48").Value = Signature ' ...........................Signature
End With
Call Envoi_Mail
On Error GoTo Sortie
TextBox4.Font.Bold = True
TextBox2 = Format(TextBox2.Value, "dd mmmm yyyy")
TextBox8 = Format(TextBox8.Value, "dd mmmm yyyy")
TextBox11.Value = LCase(TextBox11.Value)
Application.DisplayAlerts = False
Workbooks.Add
' Sauvegarde le mail sous le titre
ActiveWorkbook.SaveAs FileName:="C:\Users\" & NomUtilisateur & "\Documents\Mes Emails\" & "Email du " & _
ThisWorkbook.Sheets("Feuil6").Range("H6").Value & " pour objet " & _
ThisWorkbook.Sheets("Feuil6").Range("D14").Value & " au " & _
Format(Date, "d mmmm yyyy") & ".xlsx"
With ActiveSheet.PageSetup ' ....................................Mise en page
.LeftMargin = Application.InchesToPoints(0.59) ' ............Marge à gauche
.RightMargin = Application.InchesToPoints(0.59) ' ...........Marge à droite
.TopMargin = Application.InchesToPoints(0.98) ' .............Marge en haut
.BottomMargin = Application.InchesToPoints(0.98) ' ..........Marge en bas
End With
ThisWorkbook.Sheets("Feuil6").Cells.Copy
Range("A1").PasteSpecial
Application.CutCopyMode = False
ActiveWorkbook.Save ' ...........................................Sauvegarde du classeur
Application.DisplayAlerts = True
ActiveWorkbook.Close ' ..........................................Fermeture du classeur
MsgBox "Sauvegarde effectuée . ", vbInformation, "Message"
Sortie:
Unload Me
End Sub
Si besoin je joindrai le fichier
Toujours aussi compliqué ton code !!
j'ai modifié ma proposition pour ajouter la signature outlook
pas besoin de getboiler, .de GetInspector ou d'Application.Wait et encore moins de send.keys
je ne regarderai pas en détail ton code que tu ne sembles pas maîtriser non plus ... brode autour d'un code plus simple que voici :
Sub envoi()
Dim messagerie As Object, email As Object, PieceJointe$
On Error GoTo erreur
PieceJointe = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Set messagerie = CreateObject("Outlook.Application")
Set email = messagerie.CreateItem(0)
With email
.to = [destinataire]
.Subject = [titre]
.htmlbody = "Veuillez trouver en pièce jointe ..." & htmlbody
.ReadReceiptRequested = True
.OriginatorDeliveryReportRequested = True ' ..............Recevoir un rapport de remise
.ReadReceiptRequested = True ' ...........................Confirmation de lecture
.Attachments.Add PieceJointe
.display ' à remplacer par .send pour envoyer
End With
Set email = Nothing
Set messagerie = Nothing
Exit Sub
erreur:
MsgBox "Erreur : " & Err.Number & vbLf & Err.Description
End Sub
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
J'ai repris ta base et voici ce que cela en résulte :
Sub Envoi_Mail()
Dim MaMessagerie As Object, MonMessage As Object, PieceJointe$
Dim Sujet As String, LeDestinataire As String, AutreDestinataire As String
Dim Msg As String, Reponse As String, I As Integer
On Error GoTo erreur
PieceJointe = ThisWorkbook.Path & "\" & ThisWorkbook.Name
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.CreateItem(0)
With UserForm6
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
' Extraction des données
Sujet = .TextBox4.Value '.................................Objet
LeDestinataire = .TextBox3.Value ' ........................Destinataire référentiel
AutreDestinataire = .TextBox11.Value ' ....................Autres destinataires
' Composition du message
Msg = .TextBox5.Value & vbLf & vbLf ' .................Corps du message
Msg = Msg & .TextBox6.Value & vbLf & vbLf ' ...........Formule de droit
Msg = Msg & "Fait à " & .TextBox7.Value & vbLf & ", le " & .TextBox8.Value & vbLf & vbLf ' Lieu et Date
Msg = Msg & "Veuillez agréer, " & .TextBox9.Value & ", l'expression de mes sentiments respectueux." & vbLf & vbLf
Msg = Msg & .TextBox10.Value
' Création de l'élément de courrier
PieceJointe = .LabelPieceJointe.Caption ' ...................Pièce Jointe
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤
End With
If UserForm6.TextBox3.Value = "" Or UserForm6.TextBox4.Value = "" Then
MsgBox "Vous devez choisir un nom et saisir un titre !"
Exit Sub
UserForm6.TextBox3.SetFocus
End If
Reponse = MsgBox("Vous êtes sur le point d'envoyer un Email" & Chr(10) & _
"Voulez-vous continuer?", vbYesNo + vbExclamation, "Email")
Select Case Reponse
Case vbYes
With MonMessage
.To = LeDestinataire ' .................................Destinataire
.CC = AutreDestinataire ' ..............................Autres destinataires
.Subject = Sujet '.....................................Objet
.HTMLBody = Msg ' ......................................Corps du message
.OriginatorDeliveryReportRequested = True ' ............Recevoir un rapport de remise
.ReadReceiptRequested = True ' .........................Confirmation de lecture
.Attachments.Add PieceJointe ' .........................Piece Jointe
.Display ' à remplacer par .send pour envoyer
End With
On Error GoTo 0
MsgBox "Le courriel à été envoyé", vbOKOnly + vbInformation, "Confirmation"
Case vbNo
MsgBox "Message pas envoyé"
Exit Sub
End Select
Set MonMessage = Nothing: Set MaMessagerie = Nothing
Exit Sub
erreur:
MsgBox "Erreur : " & err.Number & vbLf & err.Description
End Sub
Donc le code fonctionne correctement sauf la pièce jointe
Je sélectionne un fichier quelqu'on que et le code fonctionne mais si j'en sélectionne plusieurs catastrophe message erreur :
Il ne me reste plus que ça et le mailing fonctionnera correctement.
Je te joins le fichier pour une meilleur vue d'ensemble.
Il permettrera d'avoir 4 groupe de contact différent pour un seul UserForm pour envoyer des mails. Ici c'est le UserForm6
Le fichier:
Cordialement
En effet, il ne faut sélectionner qu'un seul fichier à la fois
et faire autant de lignes que de pièce jointe
.Attachments.Add PieceJointe1 ' .........................Piece Jointe
.Attachments.Add PieceJointe2 ' .........................Piece Jointe
.Attachments.Add PieceJointe3 ' .........................Piece Jointe
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Je pense qu'il y a un moyen de faire une boucle car on ne peut pas jamais savoir à l'avance le nombre de pièce jointe que l'on souhaite envoyer.
Ceci est le code du CommandButton "Pièce Jointe"
'**** Correspond au programme du CommandButton3 "Pièce Jointe" ****
Private Sub CommandButton3_Click()
Dim PieceJointe As Variant
Dim Fichier As Long
PieceJointe = Application.GetOpenFilename(filefilter:="Tous (*.*), *.*", MultiSelect:=True)
If IsArray(PieceJointe) Then
For Fichier = LBound(PieceJointe) To UBound(PieceJointe)
If Fichier = 1 And LabelPieceJointe.Caption = "" Then
LabelPieceJointe.Caption = LabelPieceJointe.Caption & PieceJointe(Fichier)
Else
If Right(LabelPieceJointe, 1) = Chr(10) Then
LabelPieceJointe.Caption = LabelPieceJointe.Caption & PieceJointe(Fichier)
Else
LabelPieceJointe.Caption = LabelPieceJointe.Caption & Chr(10) & PieceJointe(Fichier)
End If
End If
Next Fichier
End If
End Sub