Inserer et récuperer la ou les pièces jointes pour un mail

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
Le_Troll_Du_27
Membre fidèle
Membre fidèle
Messages : 154
Inscrit le : 14 juillet 2015
Version d'Excel : 2019 FR 64 Bits
Contact :

Message par Le_Troll_Du_27 » 12 janvier 2018, 17:19

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
Qui donne ne doit jamais s'en souvenir, qui reçoit ne doit jamais l'oublier


Date and Time Picker and MonthView - Windows 64/32:
http://forum.excel-pratique.com/excel/date-and-time-picker-windows-64-32-t79032-20.html
Avatar du membre
fred2406
Membre impliqué
Membre impliqué
Messages : 2'059
Appréciations reçues : 37
Inscrit le : 13 mai 2014
Version d'Excel : O365Pro-2019-2011MAC
Version de Calc : 6.3

Message par fred2406 » 13 janvier 2018, 18:46

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
Je ne réponds pas aux M.P. non sollicités.
Ne pas oublier :
:btres:
Fred :O-O:
Avatar du membre
fred2406
Membre impliqué
Membre impliqué
Messages : 2'059
Appréciations reçues : 37
Inscrit le : 13 mai 2014
Version d'Excel : O365Pro-2019-2011MAC
Version de Calc : 6.3

Message par fred2406 » 13 janvier 2018, 18:53

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....
Capture.JPG
Capture.JPG (19.7 Kio) Vu 305 fois
fred
Je ne réponds pas aux M.P. non sollicités.
Ne pas oublier :
:btres:
Fred :O-O:
Avatar du membre
Le_Troll_Du_27
Membre fidèle
Membre fidèle
Messages : 154
Inscrit le : 14 juillet 2015
Version d'Excel : 2019 FR 64 Bits
Contact :

Message par Le_Troll_Du_27 » 13 janvier 2018, 19:16

fred2406 a écrit :
13 janvier 2018, 18:46
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
fred2406 a écrit :
13 janvier 2018, 18:53
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....
Capture.JPG
fred
Là par contre je ne comprends pas car je n'ai pas ce soucis là.
Qui donne ne doit jamais s'en souvenir, qui reçoit ne doit jamais l'oublier


Date and Time Picker and MonthView - Windows 64/32:
http://forum.excel-pratique.com/excel/date-and-time-picker-windows-64-32-t79032-20.html
Avatar du membre
Le_Troll_Du_27
Membre fidèle
Membre fidèle
Messages : 154
Inscrit le : 14 juillet 2015
Version d'Excel : 2019 FR 64 Bits
Contact :

Message par Le_Troll_Du_27 » 14 janvier 2018, 03:31

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 :D
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 : viewtopic.php?f=2&t=103840
Qui donne ne doit jamais s'en souvenir, qui reçoit ne doit jamais l'oublier


Date and Time Picker and MonthView - Windows 64/32:
http://forum.excel-pratique.com/excel/date-and-time-picker-windows-64-32-t79032-20.html
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message