Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2021 Revenir sur Excel

Cédric06400

XLDnaute Junior
Bonjour,

J'ai créé une petite macro pour me permettre d'envoyer un email avec pièces jointes et signature.
J'ai intégré une gestion des erreurs si l'une des pièces jointes que j'appelle est manquante

Il fonctionne parfaitement mais j'aimerais aller plus loin, en effet le message box qui indique quelle pièce jointe est manquante arrive après l'ouverture du mail, même en mode modal
J'aimerais si c'est possible que le message box s'affiche avant le .display ou qu'il y est un retour sur Excel juste après pour m'empêcher d'envoyer le mail sans la pièce jointe manquante.

Voilou

Merci de votre aide

PS : Soyer indulgent avec mon code je ne maitrise pas toutes les subtilités du codage.

Sub Mail_auto()


Dim MaMessagerie As Object
Dim MonMessage As Object
Dim MaSignature As String
Dim mess1 As String
Dim mess1CB As String
Dim mess2Tu As String
Dim mess2TuCB As String
Dim mess2 As String
Dim mess2CB As String
Dim mess1R As String
Dim mess1RCB As String
Dim mess1P As String
Dim mess2P As String
Dim mess3P As String
Dim Chemin1 As String
Dim Chemin2 As String
Dim Chemin3 As String
Dim Chemin4 As String
Dim Chemin5 As String
Dim Chemin6 As String
Dim Chemin7 As String
Dim Chemin8 As String
Dim Chemin9 As String
Dim Chemin10 As String
Dim Chemin11 As String

' On bloque le lieu de stockage des pièces jointes
Chemindossier
FinPDF

Chemin10 = Sheets("Imp").Range("x31").Value
Chemin1 = Sheets("Imp").Range("x22").Value
Chemin2 = Sheets("Imp").Range("x23").Value
Chemin3 = Sheets("Imp").Range("x24").Value
Chemin4 = Sheets("Imp").Range("x25").Value
Chemin5 = Sheets("Imp").Range("x26").Value
Chemin6 = Sheets("Imp").Range("x27").Value
Chemin7 = Sheets("Imp").Range("x28").Value
Chemin8 = Sheets("Imp").Range("x29").Value
Chemin9 = Sheets("Imp").Range("x30").Value
Chemin11 = Sheets("Imp").Range("x32").Value

Sheets("Comp").Select
Set MaMessagerie = CreateObject("Outlook.Application")
Set MonMessage = MaMessagerie.CreateItem(0)

'Contenu du message
mess1 = "Bonjour," & "<BR><BR>" & _
"Vous trouverez en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>" & "." & "<BR><BR>" & _
"Pour régler notre facture vous avez la possibilité : " & "<BR><BR>" & _
"<ul>" & _
"<li>" & "De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
"</ul>" & _
"Pourriez-vous confirmer la bonne réception de ce courriel."

mess1CB = "Bonjour," & "<BR><BR>" & _
"Vous trouverez en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>" & "." & "<BR><BR>" & _
"Pour régler notre facture vous avez la possibilité : " & "<BR><BR>" & _
"<ul>" & _
"<li>" & "De suivre ce lien pour réglé en carte bancaire " & _
"<li>" & "De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
"</ul>" & _
"Pourriez-vous confirmer la bonne réception de ce courriel."

mess2Tu = "Bonjour," & "<BR><BR>" & _
"Tu trouveras en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>" & "." & "<BR><BR>" & _
"Pourrais-tu transmettre cet email avec le dossier et la facture au client pour paiement. " & "<BR><BR>" & _
"Pour régler notre facture ton client aura la possibilité : " & "<BR><BR>" & _
"<ul>" & _
"<li>" & "De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
"</ul>" & _
"Pourriez-tu confirmer la bonne réception de ce courriel."

mess2TuCB = "Bonjour," & "<BR><BR>" & _
"Tu trouveras en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>" & "." & "<BR><BR>" & _
"Pourrais-tu transmettre cet email avec le dossier et la facture au client pour paiement. " & "<BR><BR>" & _
"Pour régler notre facture ton client aura la possibilité : " & "<BR><BR>" & _
"<ul>" & _
"<li>" & "De suivre ce lien pour réglé en carte bancaire " & _
"<li>" & "De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
"</ul>" & _
"Pourriez-tu confirmer la bonne réception de ce courriel."

mess2 = "Bonjour," & "<BR><BR>" & _
"Vous trouverez en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>" & "." & "<BR><BR>" & _
"Pourriez-vous transmettre cet email avec le dossier et la facture au client pour paiement. " & "<BR><BR>" & _
"Pour régler notre facture votre client aura la possibilité : " & "<BR><BR>" & _
"<ul>" & _
"<li>" & "De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
"</ul>" & _
"Pourriez-vous confirmer la bonne réception de ce courriel."

mess2CB = "Bonjour," & "<BR><BR>" & _
"Vous trouverez en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>" & "." & "<BR><BR>" & _
"Pourriez-vous transmettre cet email avec le dossier et la facture au client pour paiement. " & "<BR><BR>" & _
"Pour régler notre facture votre client aura la possibilité : " & "<BR><BR>" & _
"<ul>" & _
"<li>" & "De suivre ce lien pour réglé en carte bancaire " & _
"<li>" & "De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
"</ul>" & _
"Pourriez-vous confirmer la bonne réception de ce courriel."""

mess1R = "Bonjour," & "<BR><BR>" & _
"Suite à la demande de votre agence immobilière, vous trouverez en pièces jointes le dossier et la facture de votre bien." & _
"Pour régler notre facture vous avez la possibilité : " & "<BR><BR>" & _
"<ul>" & _
"<li>" & "De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
"</ul>" & _
"Pourriez-vous confirmer la bonne réception de ce courriel."

mess1RCB = "Bonjour," & "<BR><BR>" & _
"Suite à la demande de votre agence immobilière, vous trouverez en pièces jointes le dossier et la facture de votre bien." & _
"Pour régler notre facture vous avez la possibilité : " & "<BR><BR>" & _
"<ul>" & _
"<li>" & "De suivre ce lien pour réglé en carte bancaire " & _
"<li>" & "De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
"</ul>" & _
"Pourriez-vous confirmer la bonne réception de ce courriel."
mess1P = "Bonjour," & "<BR><BR>" & _
"Vous trouverez en pièces jointes le dossier et la facture acquittée du dossier <b>" & [O2] & "</b>" & "." & "<BR><BR>" & _
"Pourriez-vous confirmer la bonne réception de ce courriel."

mess2TuP = "Bonjour," & "<BR><BR>" & _
"Tu trouveras en pièces jointes le dossier et la facture acquittée du dossier <b>" & [O2] & "</b>" & "." & "<BR><BR>" & _
"Pourrais-tu transmettre cet email au client et confirmer la bonne réception de ce courriel."

mess2P = "Bonjour," & "<BR><BR>" & _
"Vous trouverez en pièces jointes le dossier et la facture acquittée du dossier <b>" & [O2] & "</b>" & "." & "<BR><BR>" & _
"Pourriez-vous transmettre cet email au client et confirmer la bonne réception de ce courriel."


'on affiche le mail
MonMessage.Display

'on récupère la signature
MaSignature = MonMessage.HTMLBody

'on construit le message
With MonMessage
.To = [F54]
.Subject = [O1]
'Choix du message
If Sheets("Comp").Range("U1").Value = "1" Then
.HTMLBody = mess1 & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "1CB" Then
.HTMLBody = mess1CB & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "2Tu" Then
.HTMLBody = mess2 & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "2TuCB" Then
.HTMLBody = mess2CB & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "2" Then
.HTMLBody = mess3 & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "2CB" Then
.HTMLBody = mess3CB & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "1R" Then
.HTMLBody = mess4 & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "1RCB" Then
.HTMLBody = mess4CB & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "1P" Then
.HTMLBody = mess1P & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "2TuP" Then
.HTMLBody = mess2P & MaSignature
End If
If Sheets("Comp").Range("U1").Value = "2P" Then
.HTMLBody = mess3P & MaSignature
End If
'Chemin des pièces jointes
On Error GoTo Message_erreurFacture
If Sheets("Imp").Range("w31").Value > "" Then
.Attachments.Add Chemin10
On Error GoTo 0
End If
On Error GoTo Message_erreurDDT
If Sheets("Imp").Range("w22").Value > "" Then
.Attachments.Add Chemin1
On Error GoTo 0
End If
On Error GoTo Message_erreurSurface
If Sheets("Imp").Range("w23").Value > "" Then
.Attachments.Add Chemin2
On Error GoTo 0
End If
On Error GoTo Message_erreurERP
If Sheets("Imp").Range("w24").Value > "" Then
.Attachments.Add Chemin3
On Error GoTo 0
End If
On Error GoTo Message_erreurAmiante
If Sheets("Imp").Range("w25").Value > "" Then
.Attachments.Add Chemin4
On Error GoTo 0
End If
On Error GoTo Message_erreurTermites
If Sheets("Imp").Range("w26").Value > "" Then
.Attachments.Add Chemin5
On Error GoTo 0
End If
On Error GoTo Message_erreurGaz
If Sheets("Imp").Range("w27").Value > "" Then
.Attachments.Add Chemin6
On Error GoTo 0
End If
On Error GoTo Message_erreurElec
If Sheets("Imp").Range("w28").Value > "" Then
.Attachments.Add Chemin7
On Error GoTo 0
End If
On Error GoTo Message_erreurPlomb
If Sheets("Imp").Range("w29").Value > "" Then
.Attachments.Add Chemin8
On Error GoTo 0
End If
On Error GoTo Message_erreurDPEEclu
If Sheets("Imp").Range("w30").Value > "" Then
.Attachments.Add Chemin9
On Error GoTo 0
End If
On Error GoTo Message_erreurDPE
If Sheets("Imp").Range("w32").Value > "" Then
.Attachments.Add Chemin11
On Error GoTo 0
End If


.Display
End With

Set MonMessage = Nothing
Set MaMessagerie = Nothing
Exit Sub
Message_erreurFacture: MsgBox ("Attention la FACTURE est manquante")
Resume Next
Message_erreurDDT: MsgBox ("Attention le DDT est manquant"), vbSystemModal
Resume Next
Message_erreurSurface: MsgBox ("Attention la SURFACE est manquante")
Resume Next
Message_erreurERP: MsgBox ("Attention l'ERP est manquant")
Resume Next
Message_erreurAmiante: MsgBox ("Attention l'AMIANTE est manquante")
Resume Next
Message_erreurTermites: MsgBox ("Attention les TERMITES sont manquantes")
Resume Next
Message_erreurGaz: MsgBox ("Attention le GAE est manquant")
Resume Next
Message_erreurElec: MsgBox ("Attention l'ELEC est manquant")
Resume Next
Message_erreurPlomb: MsgBox ("Attention le PLOMB est manquant")
Resume Next
Message_erreurDPEEclu: MsgBox ("Attention le DPE Eclu est manquant")
Resume Next
Message_erreurDPE: MsgBox ("Attention le DPE est manquant")
Resume Next
'Fin_mail
End Sub
 

Franc58

XLDnaute Occasionnel
Salut, j'ai ajouté une section pour la vérification des pièces jointes et simplifié la construction du message. A tester:

VB:
Sub Mail_auto()

    Dim MaMessagerie As Object
    Dim MonMessage As Object
    Dim MaSignature As String
    Dim mess1 As String, mess1CB As String, mess2Tu As String, mess2TuCB As String
    Dim mess2 As String, mess2CB As String, mess1R As String, mess1RCB As String
    Dim mess1P As String, mess2P As String, mess3P As String, mess2TuP As String
    Dim Chemins(1 To 11) As String
    Dim erreurs As String
    Dim i As Integer
    Dim messageIndex As String
    Dim impSheet As Worksheet
    
    ' On bloque le lieu de stockage des pièces jointes
    Chemindossier
    FinPDF
    
    ' Définir la feuille de calcul "Imp"
    Set impSheet = Sheets("Imp")

    ' Remplir les chemins des pièces jointes
    Chemins(1) = impSheet.Range("x31").Value
    Chemins(2) = impSheet.Range("x22").Value
    Chemins(3) = impSheet.Range("x23").Value
    Chemins(4) = impSheet.Range("x24").Value
    Chemins(5) = impSheet.Range("x25").Value
    Chemins(6) = impSheet.Range("x26").Value
    Chemins(7) = impSheet.Range("x27").Value
    Chemins(8) = impSheet.Range("x28").Value
    Chemins(9) = impSheet.Range("x29").Value
    Chemins(10) = impSheet.Range("x30").Value
    Chemins(11) = impSheet.Range("x32").Value

    ' Vérification des fichiers de pièces jointes
    erreurs = ""
    For i = 1 To 11
        If Chemins(i) <> "" And Dir(Chemins(i)) = "" Then
            erreurs = erreurs & "Pièce jointe " & i & " est manquante" & vbCrLf
        End If
    Next i

    ' Afficher les erreurs s'il y en a et quitter la macro
    If erreurs <> "" Then
        MsgBox "Les erreurs suivantes ont été trouvées : " & vbCrLf & erreurs, vbCritical
        Exit Sub
    End If

    ' Création du message
    Sheets("Comp").Select
    Set MaMessagerie = CreateObject("Outlook.Application")
    Set MonMessage = MaMessagerie.CreateItem(0)

    ' Contenu du message
    mess1 = "Bonjour," & "<BR><BR>" & _
            "Vous trouverez en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
            "Pour régler notre facture vous avez la possibilité : " & "<BR><BR>" & _
            "<ul>" & _
            "<li>De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
            "</ul>" & _
            "Pourriez-vous confirmer la bonne réception de ce courriel."

    mess1CB = "Bonjour," & "<BR><BR>" & _
              "Vous trouverez en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
              "Pour régler notre facture vous avez la possibilité : " & "<BR><BR>" & _
              "<ul>" & _
              "<li>De suivre ce lien pour régler en carte bancaire " & _
              "<li>De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
              "</ul>" & _
              "Pourriez-vous confirmer la bonne réception de ce courriel."

    mess2Tu = "Bonjour," & "<BR><BR>" & _
              "Tu trouveras en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
              "Pourrais-tu transmettre cet email avec le dossier et la facture au client pour paiement. " & "<BR><BR>" & _
              "Pour régler notre facture ton client aura la possibilité : " & "<BR><BR>" & _
              "<ul>" & _
              "<li>De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
              "</ul>" & _
              "Pourrais-tu confirmer la bonne réception de ce courriel."

    mess2TuCB = "Bonjour," & "<BR><BR>" & _
                "Tu trouveras en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
                "Pourrais-tu transmettre cet email avec le dossier et la facture au client pour paiement. " & "<BR><BR>" & _
                "Pour régler notre facture ton client aura la possibilité : " & "<BR><BR>" & _
                "<ul>" & _
                "<li>De suivre ce lien pour régler en carte bancaire " & _
                "<li>De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
                "</ul>" & _
                "Pourrais-tu confirmer la bonne réception de ce courriel."

    mess2 = "Bonjour," & "<BR><BR>" & _
            "Vous trouverez en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
            "Pourriez-vous transmettre cet email avec le dossier et la facture au client pour paiement. " & "<BR><BR>" & _
            "Pour régler notre facture votre client aura la possibilité : " & "<BR><BR>" & _
            "<ul>" & _
            "<li>De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
            "</ul>" & _
            "Pourriez-vous confirmer la bonne réception de ce courriel."

    mess2CB = "Bonjour," & "<BR><BR>" & _
              "Vous trouverez en pièces jointes le dossier et la facture du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
              "Pourriez-vous transmettre cet email avec le dossier et la facture au client pour paiement. " & "<BR><BR>" & _
              "Pour régler notre facture votre client aura la possibilité : " & "<BR><BR>" & _
              "<ul>" & _
              "<li>De suivre ce lien pour régler en carte bancaire " & _
              "<li>De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
              "</ul>" & _
              "Pourriez-vous confirmer la bonne réception de ce courriel."

    mess1R = "Bonjour," & "<BR><BR>" & _
             "Suite à la demande de votre agence immobilière, vous trouverez en pièces jointes le dossier et la facture de votre bien." & _
             "Pour régler notre facture vous avez la possibilité : " & "<BR><BR>" & _
             "<ul>" & _
             "<li>De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
             "</ul>" & _
             "Pourriez-vous confirmer la bonne réception de ce courriel."

    mess1RCB = "Bonjour," & "<BR><BR>" & _
               "Suite à la demande de votre agence immobilière, vous trouverez en pièces jointes le dossier et la facture de votre bien." & _
               "Pour régler notre facture vous avez la possibilité : " & "<BR><BR>" & _
               "<ul>" & _
               "<li>De suivre ce lien pour régler en carte bancaire " & _
               "<li>De régler par virement, vous trouverez nos coordonnées bancaires au bas de la facture et ce courriel." & _
               "</ul>" & _
               "Pourriez-vous confirmer la bonne réception de ce courriel."

    mess1P = "Bonjour," & "<BR><BR>" & _
             "Vous trouverez en pièces jointes le dossier et la facture acquittée du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
             "Pourriez-vous confirmer la bonne réception de ce courriel."

    mess2TuP = "Bonjour," & "<BR><BR>" & _
               "Tu trouveras en pièces jointes le dossier et la facture acquittée du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
               "Pourrais-tu transmettre cet email au client et confirmer la bonne réception de ce courriel."

    mess2P = "Bonjour," & "<BR><BR>" & _
             "Vous trouverez en pièces jointes le dossier et la facture acquittée du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
             "Pourriez-vous transmettre cet email au client et confirmer la bonne réception de ce courriel."

    mess3P = "Bonjour," & "<BR><BR>" & _
             "Vous trouverez en pièces jointes le dossier et la facture acquittée du dossier <b>" & [O2] & "</b>." & "<BR><BR>" & _
             "Pourriez-vous confirmer la bonne réception de ce courriel."

    ' Récupération de la signature
    MonMessage.Display
    MaSignature = MonMessage.HTMLBody

    ' Construction du message
    With MonMessage
        .To = [F54]
        .Subject = [O1]
        messageIndex = Sheets("Comp").Range("U1").Value
        Select Case messageIndex
            Case "1"
                .HTMLBody = mess1 & MaSignature
            Case "1CB"
                .HTMLBody = mess1CB & MaSignature
            Case "2Tu"
                .HTMLBody = mess2Tu & MaSignature
            Case "2TuCB"
                .HTMLBody = mess2TuCB & MaSignature
            Case "2"
                .HTMLBody = mess2 & MaSignature
            Case "2CB"
                .HTMLBody = mess2CB & MaSignature
            Case "1R"
                .HTMLBody = mess1R & MaSignature
            Case "1RCB"
                .HTMLBody = mess1RCB & MaSignature
            Case "1P"
                .HTMLBody = mess1P & MaSignature
            Case "2TuP"
                .HTMLBody = mess2TuP & MaSignature
            Case "2P"
                .HTMLBody = mess2P & MaSignature
            Case "3P"
                .HTMLBody = mess3P & MaSignature
        End Select

        ' Ajout des pièces jointes
        For i = 1 To 11
            If Chemins(i) <> "" Then
                .Attachments.Add Chemins(i)
            End If
        Next i

        .Display
    End With

    Set MonMessage = Nothing
    Set MaMessagerie = Nothing

End Sub
 

Cédric06400

XLDnaute Junior
Encore merci,
Ca marche parfaitement.

Me reste plus qu'a trouver une solution pour améliorer le contenu du message.

Dans ton code on défini les pièces manquantes par des numéros, j'aimerais que ce numéro corresponde à au nom de la pièce jointe manquante, nom en colonne U de la feuille.

Merci de ton aide

Cédric
 

Franc58

XLDnaute Occasionnel
Je me rends compte que je ne t'ai pas donné la modification complète, la voici:

VB:
' Remplir les noms des pièces jointes
    Dim NomsPieces(1 To 11) As String
    For i = 1 To 11
        NomsPieces(i) = impSheet.Range("U" & (21 + i)).Value
    Next i

    ' Vérification des fichiers de pièces jointes
    erreurs = ""
    For i = 1 To 11
        If Chemins(i) <> "" And Dir(Chemins(i)) = "" Then
            erreurs = erreurs & "Pièce jointe manquante : " & NomsPieces(i) & vbCrLf
        End If
    Next i
 

Discussions similaires

Réponses
17
Affichages
2 K
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…