Inserer et récuperer la ou les pièces jointes pour un mail
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonjour, avant tous les Meilleurs Vœux à tous.
J'ai presque fini mes codes userform pour plusieurs listes de diffusion avec un mailing avec une ou plusieurs pièces jointes.
Tous se passe dans l'UserForm6 qui récupère les infos de l'Userform(i) ouvert
Private Sub CommandButton3_Click()
Dim MaMessagerie As Outlook.Application
Dim MonMessage As Object
Dim fichier As Variant
Dim Sujet As String, LeDestinataire As String, msg As String, Réponse As String
On Error Resume Next
'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
Set MaMessagerie = New Outlook.Application
Set MonMessage = MaMessagerie.CreateItem(0)
Set MonMessage = MaMessagerie.CreateItem(olMailItem)
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
fichier = 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
fichier = 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
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}"
Else
.To = LeDestinataire ' Destinataire
.CC = Me.TextBox3.Value ' Liste des adresse Mail
.Subject = Sujet ' Objet
.Body = msg ' Corps du message
.Attachments.Add fichier ' Pièce Jointe
.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}"
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
Unload UserForm6
End Sub
'**** Correspond au programme du CommandButton4 "Pièce Jointe" ****
Private Sub CommandButton4_Click()
LabelPieceJointe.Caption = Application.GetOpenFilename("Tous,*.*", , "Fichiers ..., MultiSelect:=True")
Voici les dernières étapes où je peine à trouver
1 - Inserer et récuper la ou les pièces jointes dans le mail ( Je n'arrive pas à comprendre pour un envoi de plusieurs PJ)
2 - Vérifier si la pièce jointe est présente dans le mail sinon: msgbox "Attention il n'y a pas de pièce jointe" , vbYesNo + vbQuestion, "Voulez vous continuer?"
3 - Vérifier qu'un dossier "Archives des mails envoyés" est crée sinon le créer et y insérer toutes les pièces jointes envoyées
4 - Réviser tout le classeur afin de repérer les incohérences et les érreurs
Cordialement
Bonjour
pour ta première étape joindre plusieurs pieces jointes il suffit de faire 2 fois .attachments.add
exemple :
.Attachments.Add ActiveWorkbook.Path & "\" & nomfic 'attache le fichier au mail
.Attachments.Add ActiveWorkbook.Path & "\" & nomfic2
pour le reste je ne sais pas vérifier si une pièce est effectivement attachée....
fred
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
Bonjour
pour ta première étape joindre plusieurs pieces jointes il suffit de faire 2 fois .attachments.add
exemple :
.Attachments.Add ActiveWorkbook.Path & "\" & nomfic 'attache le fichier au mail .Attachments.Add ActiveWorkbook.Path & "\" & nomfic2
pour le reste je ne sais pas vérifier si une pièce est effectivement attachée....
fred
Ok si l'ai bien compris il faut que je créai 2 variables pièce jointes alors
et pour info quand j'essai d'activer les macros sur ton fichier j'ai ce message d'erreur qui apparait un certain nombre de fois....
fred
Là par contre je ne comprends pas car je n'ai pas ce soucis là.
- Messages
- 156
- Excel
- 2019 FR 64 Bits
- Inscrit
- 14/07/2015
- Emploi
- Ex-Conducteur Routier de convoi exceptionnel
J'ai corrigé quelques bugs
Il me reste plus que l'envoi du mail avec la où les pièces jointes.
J'ai corrigé le code mais je ne vois pas le ou les mails partir avec leurs pièces. Donc aucune idée si cela fonctionne.
Par contre il me reste aussi Archiver avec la ou les PJ ou alors sur le fichier créer mettre la cellule en Hypertexte et l'aperçu si c'est utile
Plus besoin de l'UserForm9 car le dossier se créait automatiquement dès l'ouverture pour les stockage des mails envoyés
Sujet renvoyé ici : https://forum.excel-pratique.com/viewtopic.php?f=2&t=103840