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

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

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

fred

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à.

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

Rechercher des sujets similaires à "inserer recuperer pieces jointes mail"