XL 2019 On error et envoi de pièce jointe

david54520

XLDnaute Junior
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

XLDnaute Barbatruc
Bonjour,

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
C'est normal : la macro se déroule instruction par instruction donc, qu'il y ait erreur ou pas, l'instruction d'affichage de la MsgBox sera toujours affichée.

Soit tu déplaces ton étiquette pb1, soit tu gères différemment l'erreur. 😉
 

david54520

XLDnaute Junior
Bonjour à tous et merci pour vos réponses
-wdoog66 : j'envoie tout le code dans un message juste en suivant
-oneida : il peut y avoir une erreur mauvais nom de PJ ou chemin mal foutu (sachant que les noms de PJ dans la macro sont reconstitué via des formules dans le fichier selon une procédure particulière. l'utilisateur doit suivre la meme procédure pour nommer ces pièces jointe - Idem pour le chemin)
-tooF
-dysorthographie : je vais tenter ta proposition
 

david54520

XLDnaute Junior
voilà le code complet, sans la tentative de code les erreurs
en l'état, çà fonctionne exactement comme je souhaite....
il me reste à intégrer ces notions d'erreur de PJ

a+


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_CFP")
Set ShM = ThisWorkbook.Sheets("mail_texte")

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


For i = 2 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("S" & i).Value & " " & Sh.Range("aC" & i) & ","

' intégrer l'intitulé
Range("A10").Select
ActiveCell.FormulaR1C1 = "blablablablablablablablablablabla" & Sh.Range("aW" & i).Value


With oMail

.Display

Set oObjetWord = .GetInspector.WordEditor

.To = Sh.Range("a" & i).Value


If Sh.Range("f" & i).Value = "" Then GoTo pointsuite1
.attachments.Add PJ1

pointsuite1:
If Sh.Range("g" & i).Value = "" Then GoTo pointsuite2
.attachments.Add PJ2

pointsuite2:
If Sh.Range("h" & i).Value = "" Then GoTo pointsuite3
.attachments.Add PJ3

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

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

pointsuite5:
If Sh.Range("j" & i).Value = "" Then GoTo pointsuite6
.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
 

wDog66

XLDnaute Occasionnel
Re,

Pouvez-vous éditer votre post et mettre le code entre balises comme déjà dit SVP
1721994265858.png

Puis vous le collez et validez
1721994317595.png


A+
 

Pièces jointes

  • 1721994296200.png
    1721994296200.png
    9.4 KB · Affichages: 3

david54520

XLDnaute Junior
VB:
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_CFP")
Set ShM = ThisWorkbook.Sheets("mail_texte")

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


For i = 2 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("S" & i).Value & " " & Sh.Range("aC" & i) & ","

' intégrer l'intitulé de la formation
        Range("A10").Select
        ActiveCell.FormulaR1C1 = "Vous trouverez, ci-joint, les documents concernant " & Sh.Range("aW" & 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 GoTo pointsuite1
       .attachments.Add PJ1
              
pointsuite1:
        If Sh.Range("g" & i).Value = "" Then GoTo pointsuite2
       .attachments.Add PJ2

pointsuite2:
        If Sh.Range("h" & i).Value = "" Then GoTo pointsuite3
        .attachments.Add PJ3

pointsuite3:
        If Sh.Range("i" & i).Value = "" Then GoTo pointsuite4
        .attachments.Add PJ4
  
pointsuite4:
        If Sh.Range("j" & i).Value = "" Then GoTo pointsuite5
        .attachments.Add PJ5
        
pointsuite5:
        If Sh.Range("j" & i).Value = "" Then GoTo pointsuite6
        .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
 

TooFatBoy

XLDnaute Barbatruc
message parti trop vite....
Tu as un bouton pour modifier tes messages. ;)


-toofatboy : c'est bien ce que je cherche : faire différemment...mais il me manque de la compétence, de la technique
Je pense que tu te sous-estimes et que tu as les compétences pour mettre l'étiquette ailleurs ou ajouter d'autres étiquettes (par exemple "Fin:") et des sauts vers lesdites étiquettes (par exemple "GOTO Fin").

En revanche, en ce qui concerne le fait de "gérer différemment l'erreur", c'est effectivement plus délicat mais dysorthographie t'a donné un exemple. 👍


Bonne continuation
🖖
 
Dernière édition:

david54520

XLDnaute Junior
Je poursuis les tests avec le solution de dysorthographhie vraiment satisfaisante.
mais, ......je souhaiterais quand il y a une erreur, insérer un exit SUB aprés le message d'erreur ....
et si pas erreur, on continue
mais je ne trouve pas la bonne place ou indiquer cette commande
en effet, s'il n'y a pas d'erreur....il fait tout de même un exit SUB
J'ai tenté avec un Else....mais je ne trouve pas la bonne façon

si vous avez des pistes, je suis preneur

a+ David
 

Discussions similaires

Réponses
6
Affichages
311

Statistiques des forums

Discussions
313 866
Messages
2 103 082
Membres
108 521
dernier inscrit
manouba