Microsoft 365 VBA envoi mail avec PJ multiples

[ExcLnoob]

Bonsoir le Forum,

J'aurai besoin de vos lumières...
J'ai une macro me permettant d'envoyer un mail en y joignant une PJ ou non.
Mon souci est que je ne peux joindre qu'1 PJ alors que j'ai parfois besoin d'en joindre plusieurs comme je peux le faire avec Outlook.
Pourriez-vous sm'aider svp ?

Ci-joint le code en question :

Public Sub PrEnvoiMailPJ(deb As Integer, fin As Integer)

Dim OutlookApp As Object
Dim OutlookMail As Object
Dim Destinataire As String
Dim PJ As String
Dim i As Integer
   
If MsgBox("Voulez-vous joindre un document à votre mail ?", vbYesNo + vbQuestion) = vbYes Then
    PJ = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
        If PJ <> "" Then
        MsgBox "Opération annulée !" & Chr(10) & "Cliquer à nouveau pour joindre une nouvelle PJ ou envoyer votre mail", vbInformation, "Information"
        Exit Sub
        End If
    MsgBox "Mail en préparation..." & Chr(10) & "xxxxxx", vbExclamation
        With Sheets("Feuil1")
            For i = deb To fin
                Destinataire = .Cells(i, "E")
                Set OutlookApp = CreateObject("outlook.application")
                Set OutlookMail = OutlookApp.createitem(0)
                    With OutlookMail
                        .Subject = "xxxxx - " + UserForm1.TextBox3.Value
                        .To = Destinataire
                        .CC = UserForm1.TextBox2.Value
                        .Body = UserForm2.TextBox1.Value
                        .attachments.Add PJ
                        .Display
                        '.send
                    End With
            Next i
        End With
Else
    MsgBox "Mail en préparation..." & Chr(10) & "xxxxxx", vbExclamation
        With Sheets("Feuil1")
            For i = deb To fin
            Destinataire = .Cells(i, "E")
            Set OutlookApp = CreateObject("outlook.application")
            Set OutlookMail = OutlookApp.createitem(0)
                With OutlookMail
                    .Subject = "xxxx - " + UserForm1.TextBox3.Value
                    .To = Destinataire
                    .CC = UserForm1.TextBox2.Value
                    .Body = UserForm2.TextBox1.Value
                    .Display
                    '.send
                End With
            Next i
        End With
End If
End Sub

Merci !!!

 

[MP59]

Bonjour,
.attachments.Add PJ1
.attachments.Add PJ2
...
ne suffit-il pas ?

 

[zebanx]

Bonjour Excelnoomb, mp59, le forum

@MP59 : vous avez la bonne approche mais il faut définir les PJ à attacher.
Et dans ce cas, ne vaut-il pas mieux passer par Application.FileDialog(msoFileDialogFilePicker) plutôt que par Application.GetOpenFilename("Tous les fichiers (*.*),*.*") ?

Par exemple sur un fichier test et les codes ci-joints pour des fichiers xlsx et xlsm :

Public PJ(), m As Integer
Sub sh02_mailto_pj_filedialog()
'-- avec 1 pièce jointe en colonne K(11)
With Sheets("sh02_mailto")
    dl = .Cells(Rows.Count, 2).End(xlUp).Row
    Set ol = CreateObject("outlook.application")
    '--boucle
    For i = 2 To dl
        If Cells(i, 9) = "x" Then        '--- choix des destinataires
            Cells(i, 10) = ""
            Set ml = ol.createitem(0)
            ml.To = .Cells(i, 4)
            ml.Subject = .Cells(i, 7)
            ml.CC = .Cells(i, 5)
            ml.BCC = .Cells(i, 6)
            ml.Body = .Cells(i, 8)
                If MsgBox("Voulez-vous joindre un document à votre mail ?", vbYesNo + vbQuestion) = vbYes Then
                Call SelectMFiles(i)
                '--- M1 : utilisation de cellules pour conserver une trace
                'dercol = Cells(i, Columns.Count).End(1).Column
                'For j = 12 To dercol
                'ml.attachments.Add .Cells(i, j).Value
                'Next j
                 '--- M2 : utilisation des données directement
                For j = 1 To m - 1
                ml.attachments.Add PJ(j, 1)
                Next j
                Else
                End If
            ml.Display 'afficher le mail
            Cells(i, 10) = Now
            End If
    Next i
End With
End Sub
Sub SelectMFiles(i)
    Dim fDialog As FileDialog
    Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
    ReDim PJ(1 To 10, 1 To 1)
    With fDialog
        .AllowMultiSelect = True
        .Title = "Please select the files"
        .Filters.Clear
        .Filters.Add "All supported files", "*.xlsb;*.xlsm"
        .Filters.Add "XLSB Files", "*.xlsb"
        .Filters.Add "XLSM files", "*.xlsm"
        If .Show = True Then
            Dim fPath As Variant
            m = 1
            For Each fPath In .SelectedItems
                PJ(m, 1) = fPath
                m = m + 1
            Next
        End If
    End With
'--si choix méthode M1 (path affiché colonnes L et suivantes)
'Cells(i, 12).Resize(1, 10) = ClearContents
'Cells(i, 12).Resize(1, m) = Application.Transpose(PJ)
End Sub

En tout cas, ça vous donne une idée de ce qui ne "colle" pas dans votre code.

xl-ment

 

[ExcLnoob]

Bonjour le Forum,

Merci pour vos retours
Oui cela pourrait le faire mais je souhaiterai pouvoir selectionner 2 PJ dans le même explorateur et le chemin des fichiers ne peut être figé car les PJ jointes ne seront jamais les mêmes.

De plus j'ai fait une bétise...
En effet, j'ai voulu laisser le droit à l'erreur aux utilisateurs en isérant cette partie de code :

If PJ <> "" Then
   MsgBox "Opération annulée !" & Chr(10) & "xxxxx", vbInformation, "Information"
  Exit Sub
 End If

Malheureusement, "Opération annulée" même si je joins une PJ. J'ai donc remplacé <> par = (logique...) mais à ce moment là, je peux joindre une PJ mais plus le droit de cliquer sur "Annuler" ou la croix rouge de l'explorateur sans lancer le débogueur : "Fichier introuvable". Logique me direz-vous, mais il faudrait que je puisse annuler mon action en lançant cette MsgBox sans déboguer...
Une idée ?

Merci encore

 

[zebanx]

Bonjour Excelnoob

Un essai sur la gestion d'erreur avec cette messagebox.

Sub msgb()
On Error Resume Next
retour:
If msgbox("Voulez-vous joindre un document à votre mail ?", vbYesNo + vbQuestion) = vbYes Then
    PJ = Application.GetOpenFilename("Tous les fichiers (*.*),*.*")
    '-- gestion echappe
    If PJ Is Nothing Then '--échappe donne erreur sur le code mais avec resume next on passe ligne suivante
        If Err.Number <> 0 Then '--il y a une erreur donc le code va se poursuivre
        msgbox "Opération annulée !"
        'Err.Clear
        GoTo retour  '-- retour à la message box
        End If
    End If
End If
End Sub

 

[ExcLnoob]

Je vois l'idée mais cela me déclenche une erreur et des bugs...
En effet, incompatibilité de type pour PJ. Je remplace donc PJ par Application.GetOpenFilename("Tous les fichiers (*.*),*.*") amis cela m'ouvre donc 2 fois l'explorateur sans doute parce que j'ai fait ce changement.
Faut-il que je change Dim PJ As String ?
En mettant une option Oui/Non sur la MsgBox "Opération annulée" si j'arrive à définir le type de PJ je pense que l'on toucherai au but non ?
Merci...

 

[zebanx]

Re.
Non.
Il y a un filtre sur le type de fichier.
On le neutralise.

        .Filters.Clear
        '.Filters.Add "All supported files" , "*.xlsb;*.xlsm"
       ' .Filters.Add "XLSB Files", "*.xlsb"
       ' .Filters.Add "XLSM files", "*.xlsm"
        If .Show = True Then

Et là on peut joindre n'importe quel type de fichier (pdf, doc...)

@+

 

[ExcLnoob]

@zebanx
Je vais essayer d'adapter ce code à mon fichier, merci!!!
Une question cependant :
Quand je clique sur le bouton sur joindre un fichier "Oui" et que finalement j'annule ou que je ferme le navigateur avec la croix rouge, cette macro prépare quand même le message.
Je souhaiterai quand je lique sur "Annuler" ou sur la croix rouge de l'explorateur afficher une MsgBox "Operation annulée" et repartir à zéro, cad cliquer à nouveau sur le bouton pour recommencer le processus.
Ou puis-je implémenter cette MsgBox svp ?
Merci.

 

[zebanx]

Re-
Ce sera l'objet d'une autre question... Je n'ai pas trop l'habitude avec les MsgBox et je ne peux pas comprendre avec ces explications sans fichier (de préférence) ou image le cas échéant.
Idéalement, il faudrait bien avancer sur votre code, fournir un petit fichier et faire une demande sur un autre fil (s'il n'y a pas de réponses complémentaires).
Ce ne sont pas des demandes trop lourdes, vous devriez avoir des réponses.

 

[ExcLnoob]

Re
Effectivement... Je comprends, ma question était sur le fait de joindre plusieurs PJ...
Ok, j'implémente votre code dans mon fichier et si tout fonctionne je marquerai votre message en solution. Sinon je reviendrai... 😉
Si je n'arrive pas à implémenter la MsgBox au bon endroit je relancera un topic!
Merci en tout cas!!

 

[ExcLnoob]

Re, re, re...
@zebanx
Je n'ai pas réussi à adapter ton code à mon fichier...
Cependant je le note comme solution car il répond effectivement à la problématique première.
La bonne nouvelle c'est que j'ai quand même réussi à solutionner tous mes problèmes.
Je peux donc maintenant envoyer en 1 manip 15 mails à 15 destinataires différents selon un groupe prédéfini en joignant dans tous les mails plusieurs fichiers de tous formats en 1 fois également et j'ai bien la MsgBox en cas d'annulation sur la fenêtre de l'explorateur Windows (mon fameux droit à l'erreur)...
J'ai bien souffert mais c'est j'étais pas loin en fait!! Oufff
En tout cas, merci beaucoup pour votre aide.
Je joins le code pour ceux que cela intéresse :

Public Sub PrEnvoiMailPJ(deb As Integer, fin As Integer)

Dim OutlookApp As Object
Dim OutlookMail As Object
Dim Destinataire As String
Dim PJ As Variant
Dim i As Integer
Dim j As Integer

 
If MsgBox("Voulez-vous joindre un document à votre mail ?", vbYesNo + vbQuestion) = vbYes Then
    PJ = Application.GetOpenFilename("Tous les fichiers (*.*),*.* ", 1, "Sélectionnez le ou les fichiers à importer", , True)
    If IsArray(PJ) = False Then      
MsgBox "Opération annulée !" & Chr(10) & "xxxxx", vbInformation, "Information"
        Exit Sub
        End If

    MsgBox "Mail en préparation..." & Chr(10) & "xxxxxx", vbExclamation
        With Sheets("Feuil1")
            For i = deb To fin
                Destinataire = .Cells(i, "E")
                Set OutlookApp = CreateObject("outlook.application")
                Set OutlookMail = OutlookApp.createitem(0)
                    With OutlookMail
                        .Subject = "xxxxx - " + UserForm1.TextBox3.Value
                        .To = Destinataire
                        .CC = UserForm1.TextBox2.Value
                        .Body = UserForm2.TextBox1.Value
                    For j = 1 To UBound(PJ)
                        .attachments.Add PJ(j)
                    Next
                        .Display
                        '.send
                    End With
            Next i
        End With

Else

    MsgBox "Mail en préparation..." & Chr(10) & "xxxxxx", vbExclamation
        With Sheets("Feuil1")
            For i = deb To fin
            Destinataire = .Cells(i, "E")
            Set OutlookApp = CreateObject("outlook.application")
            Set OutlookMail = OutlookApp.createitem(0)
                With OutlookMail
                    .Subject = "xxxx - " + UserForm1.TextBox3.Value
                    .To = Destinataire
                    .CC = UserForm1.TextBox2.Value
                    .Body = UserForm2.TextBox1.Value
                    .Display
                    '.send
                End With
            Next i
        End With
End If
End Sub

Bonne soirée à tous!!