XL 2019 On error et envoi de pièce jointe

[david54520]

Bonjour

Ce que je souhaite : via une macro, envoyer message et plusieurs PJ.
Plusieurs essais faits --> tout fonctionne
Mais je souhaite arrêter la procédure si pb avec la PJ 1, ou 2 ou 3 etc

J'ai écrit :
If Sh.Range("f" & i).Value = "" Then GoTo pointsuite1
On Error GoTo pb1
.attachments.Add PJ1
pb1: MsgBox "pb avec PJ1"

pointsuite1:
If Sh.Range("g" & i).Value = "" Then GoTo pointsuite2
On Error GoTo pb2
.attachments.Add PJ2
pb2: MsgBox "pb avec PJ2"

pointsuite2:





or, même s'il n'y a pas d'erreur (par exemple la pièce jointe1 est trouvée et rattachée au mail..... le système va tout même à la balise pb1 et génère donc le message

je dois mal gérer le "on error"...mais je ne trouve pas le bon positionnement
si vous avez des idées, je suis preneur

merci !! David

 

[TooFatBoy]

Poste ton classeur qu'on voit où tu en es.

 

[dysorthographie]

tu as raison de te compliquer la vie!
Plutôt que de sauter ce que tu ne dois pas faire exécutés que ce que tu dois faire.

'If Sh.Range("f" & i).Value = "" Then GoTo pointsuite1
      ' .attachments.Add PJ1
If Sh.Range("f" & i).Value <> "" Then
   if dir(PJ1)<>"" then .attachments.Add PJ1
end if

 

[david54520]

Re
-TooFatBoy : désolé, je ne peux poster le classeur en l'état...données confidentielles
-dysorthographie : merci pour la proposition intermédiaire --> je la tente

a+

 

[TooFatBoy]

TooFatBoy : désolé, je ne peux poster le classeur en l'état...données confidentielles

Oui, normal.
Sinon, tu peux poster la macro complète dans ton message, sans oublier de la mettre dans la balise code.

 

[david54520]

Sub Envoi_mails()
Dim oOutlook As Object
Dim oMail As Object

Dim PJ1 As String
Dim PJ2 As String
Dim PJ3 As String
Dim PJ4 As String
Dim PJ5 As String
Dim PJ6 As String

Dim Sh As Worksheet
Dim ShM As Worksheet

Dim oObjetWord As Object

Dim i As Integer
Dim DLG As Integer

Set Sh = ThisWorkbook.Sheets("publipostage")
Set ShM = ThisWorkbook.Sheets("mail_texte")

DLG = Sh.Range("a500").End(xlUp).Row


For i = 3 To DLG
If Sh.Range("L" & i).Value <> "NON" Then


Set oOutlook = CreateObject("Outlook.Application")
Set oMail = oOutlook.CreateItem(0)

PJ1 = Sh.Range("f" & i).Value

PJ2 = Sh.Range("g" & i).Value

PJ3 = Sh.Range("h" & i).Value

PJ4 = Sh.Range("i" & i).Value

PJ5 = Sh.Range("j" & i).Value

PJ6 = Sh.Range("k" & i).Value
      

    ShM.Select
' intégrer le genre et le nom de la personne dans la cellule de bonjour
        Range("A8").Select
        ActiveCell.FormulaR1C1 = "Bonjour " & Sh.Range("u" & i).Value & " " & Sh.Range("ae" & i) & ","

' intégrer l'intitulé de la formation
        Range("A10").Select
        ActiveCell.FormulaR1C1 = "Vous trouverez, ci-joint, les documents  " & Sh.Range("ay" & i).Value

'ShM.Range("A8:a23").Select


    With oMail
    
        .Display
        Set oObjetWord = .GetInspector.WordEditor
        .To = Sh.Range("a" & i).Value
        
  
        If Sh.Range("f" & i).Value <> "" Then
    
        If Dir(PJ1) <> "" Then .attachments.Add PJ1
        End If
      
pointsuite1:

        If Sh.Range("g" & i).Value <> "" Then
  
       If Dir(PJ2) <> "" Then .attachments.Add PJ2
       Else: MsgBox "pb"
        End If

pointsuite2:
        If Sh.Range("h" & i).Value = "" Then GoTo pointsuite1
      
         On Error Resume Next
        .attachments.Add PJ3


pointsuite3:
        If Sh.Range("i" & i).Value = "" Then GoTo pointsuite1
        .attachments.Add PJ4
    
pointsuite4:
       If Sh.Range("j" & i).Value = "" Then GoTo pointsuite1
       .attachments.Add PJ5

        
pointsuite5:
        If Sh.Range("k" & i).Value = "" Then GoTo pointsuite1
        .attachments.Add PJ6

        
pointsuite6:


        .Subject = Sh.Range("d" & i).Value
        Set oObjetWord = .GetInspector.WordEditor
      ShM.Range("A8:a23").Copy
      
        oObjetWord.Range(0).Paste
    
     'Send si on veut envoyer
    
    Dim dtAujourdhui As String
   dtAujourdhui = Format(Date, "dd mmmm yyyy")

    Sh.Range("n" & i).Value = "Envoyé la " & dtAujourdhui
 

    End With
End If
       Set oMail = Nothing: Set oOutlook = Nothing
Next i

Sh.Select


MsgBox "Messages Envoyés"




End Sub

 

[david54520]

voila donc mon code complet.
La dernière solution marche tout bien pour la PJ1 : normal, elle existe bien
la PJ2 n'existe pas et la procédure passe bien le truc et continue le process

mais....tordu que je suis...je souhaiterais que si une des pièces jointes n'est pas trouvé alors
- je puisse afficher un message pour l'utilisateur
- et exit sub

j'ai donc tenté déjà le Else avec une msgbox pour la PJ2....mais çà ne le fait pas
Pour le moment je fais des tests que la PJ1 et la Pj2, quand j'aurais la solution, je la démultiplierai pour les autres PJ.

Encore merci de vous intéresser au sujet !!

a+

 

[TooFatBoy]

If Dir(PJ1) = "" Then
    Msgbox "pb"
    exit sub
else
    .attachments.Add PJ1
End If

C'est un truc comme ça que tu as déjà essayé ?

 

[dysorthographie]

Bonjour,
Je ne comprends pas ce qui t'empêche de nous fournir un fichier avec 3,3 lignes de données complètement bidon afin de te proposer une solution.

Nous ne sommes pas demandeur, nous ne voulons que t'aider.

 

[Oneida]

Bonjour a tous,

david54520​

Dans votre code vous affectez les varialble PJ1 a PJ6 avec une valeur de cellules et ensuite vous testez les dites cellules si elles sont vides. Donc pas besoin des PJx et y a plus simple comme code pour eviter les pointsuite1: ect


Parcontre avec votre code, je n' arrive pas a comprendre si vous voulez avoir une ou plusieurs PJ dans le meme tour de la boucle

For i = 2 To DLG

!

D'ou le besoin de fichier demande par dysorthographie
Avec un explication au top si possible

 

[david54520]

Bonjour à tous

- Oneida : oui, au final il y aura plusieurs pièces jointes. Chaque ligne est un individu et....ils ne reçoivent pas tous les même type de pièce jointe. (géré par des formules dans le tableau. Certaines cellules reprenant les PJ seront donc vides. et j'avais donc pensé que le sytème de pointsuite1: etc me permettait de gérer ce point.

- Dysorthographie et Oneida : oui, ayant déja utilisé ce forum, je sais bien que les gens qui sont là et qui répondent n'ont à priori que la volonté d'aider les demandeurs. Merci pour çà

Et je m'apprêtais à finaliser un tableau bidon pour vous le partager quand....
j'ai testé la dernière proposition de TooFatBoy....qui manifestement fonctionne parfaitement !!

et quand on la regarde cette proposition....elle apparait limpide et simple.

Bref, c'est nickel

Semaine prochaine je continue de bosser sur le fichier et si pb, je reviendrai poster.

En attendant, merci beaucoup. Très bon week end !!
David

 

[TooFatBoy]

Pour peaufiner tout ça, il faudrait savoir si tu veux vraiment
- afficher un message d'alerte,
- afficher un message pour chaque mail,
- continuer vers les autres mails quand il manque au moins une PJ,
- etc.

 

[david54520]

Salut tout le monde

Tout fonctionne !
tout ?...Sauf un petit truc

Rappel :
- la macro fonctionne avec un boucle for (jusque dernier ligne non vie)
- pour chaque ligne,
- génère un mail avec corps de mail personnalisé,
- avec des pièces jointes attitrées
- le mail s'affiche (pas de d'envoi automatique dans cette version pour que l'utilisateur puisse s'assurer de ce qu'il y a dans son mail - Une version 2 fera l'envoi automatique )
- le mail reste à l'affichage et le système passe à la ligne suivante - individu suivant

à la fin de la procédure, tous les mails générés sont affichés. l'utilisateur vérifie et clique sur envoi

Dans ce process (et avec votre aide donc) a été mise en place un système de gestion d'erreur de PJ qui permet
- de générer un mesage pour l'utilisateur (quel individu et quel PJ pose problème)
- fermeture du mail en cours de finalisation
- sortie de la macro

le petit pb qui reste :
- la macro passe l'individu 1, tout est ok, mail affiché
- la macro passe l'individu 2, tout est ok, mail affiché
- la macro passe l'individu 3 , ...problème, message, ...mail pour l'individu 3 supprimé, sortie de la procédure

Existe-t-il un bout de code qui permettrait de supprimer TOUS les mails qui sont prêts (dans l'exemple ci dessus je souhaiterai que la macro ferme aussi les mails destinés aux individus 1 et 2.

J'ai une solution de contournement en tête au cas ou

joint : le bout de code . et donc le oMail, Delete qui ferme bien LE mail en cours de fabrication mais pas LES mails

Je vous dis déjà merci

 With oMail
    
        .Display
        Set oObjetWord = .GetInspector.WordEditor
        .To = SHe.Range("x" & j).Value
        
  
        If SHe.Range("f" & j).Value = "" Then GoTo pointsuite1
    
         If Dir(PJ1) = "" Then
             MsgBox "Problème avec PJ1 concernant " & SHe.Range("aF" & j) & ", " & SHe.Range("p" & j) & Err.Description
             oMail.Delete
             Exit Sub
            Else
                .attachments.Add PJ1
             End If
            
pointsuite1:

      
        If SHe.Range("g" & j).Value = "" Then GoTo pointsuite2
    
         If Dir(PJ2) = "" Then
             MsgBox "Problème avec PJ2 concernant " & SHe.Range("aF" & j) & ", " & SHe.Range("p" & j) & Err.Description
            oMail.Delete
             Exit Sub
            Else
                .attachments.Add PJ2
             End If

pointsuite2:
 
        .Subject = SHe.Range("d" & j).Value
        Set oObjetWord = .GetInspector.WordEditor
      SHMe.Range("A8:a22").Copy
      
        oObjetWord.Range(0).Paste
    
     'Send si on veut envoyer
    
    Dim dtAujourdhui As String
   dtAujourdhui = Format(Date, "dd mmmm yyyy")

    SHe.Range("N" & j).Value = "Envoyé le " & dtAujourdhui
 

    End With

 

[wDog66]

Bonjour le fil,

Je n'ai pas tout suivi, désolé,
mais si on reprend le code du #11, pourquoi ne pas avoir fait ça

Sub Envoi_mails()
  Dim oOutlook As Object, oObjetWord As Object
  Dim oMail As Object
  Dim Sh As Worksheet, ShM As Worksheet
  Dim Lig As Long, dLig As Long, Col As Long

  Set Sh = ThisWorkbook.Sheets("publipostage_CFP")
  Set ShM = ThisWorkbook.Sheets("mail_texte")
  dLig = Sh.Range("a500").End(xlUp).Row
  ' Pour chaque ligne
  For Lig = 2 To dLig
    If Sh.Range("L" & Lig).Value <> "NON" Then
      ' Préparer le mail
      Set oOutlook = CreateObject("Outlook.Application")
      Set oMail = oOutlook.CreateItem(0)
      ' Mise en place du bonjour
      ShM.Range("A8").FormulaR1C1 = "Bonjour " & Sh.Range("S" & Lig).Value & " " & Sh.Range("aC" & Lig) & ","
      ' Mise en place de l'intitulé
      ShM.Range("A10").FormulaR1C1 = "blablablablablablablablablablabla" & Sh.Range("aW" & Lig).Value
      ' Afficher le mail
      With oMail
        .Display
        Set oObjetWord = .GetInspector.WordEditor
        .To = Sh.Range("a" & Lig).Value
        For Col = 6 To 11  ' Colonnes de F à K
          If Sh.Cells(Lig, Col) <> "" Then
            .attachments.Add Sh.Cells(Lig, Col)
          End If
        Next Col
        .Subject = Sh.Range("d" & Lig).Value
        Set oObjetWord = .GetInspector.WordEditor
        ShM.Range("A8:A23").Copy
        oObjetWord.Range(0).Paste
        'Send si on veut envoyer
      End With
      Dim dtAujourdhui As String
      dtAujourdhui = Format(Date, "dd mmmm yyyy")
      Sh.Range("n" & Lig).Value = "Envoyé la " & dtAujourdhui
      Set oMail = Nothing: Set oOutlook = Nothing
    End If
  Next Lig
  Sh.Select
  MsgBox "Messages Envoyés"
End Sub

A+

 

[david54520]

Salut wDog66;

Ne soit pas désolé !! tu t'intéresse à mon sujet, alors...

"pourquoi ne pas avoir fait çà" : parce que je n'y ai pas pensé, mais voilà une autre façon de gérer la partie PJ qui je vais explorer donc
Merci !

Mais, sauf erreur de ma part, ca ne réglerait pas le petit pb évoqué ce matin en #27

a+

 

[TooFatBoy]

Est-ce que #27 est une réponse à #26 ?