XL 2019 On error et envoi de pièce jointe

D

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
 
Trier par date Trier par votes
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
Bonjour,

david54520 à dit:
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
Cliquez pour agrandir...
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. 😉
 
Vote positif 0 Vote négatif
D

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
 
Vote positif 0 Vote négatif
D

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
 
Vote positif 0 Vote négatif
wDog66

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
Vote positif 0 Vote négatif
D

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
 
Vote positif 0 Vote négatif
TooFatBoy

TooFatBoy

XLDnaute Barbatruc
david54520 à dit:
message parti trop vite....
Cliquez pour agrandir...
Tu as un bouton pour modifier tes messages. ;)


david54520 à dit:
-toofatboy : c'est bien ce que je cherche : faire différemment...mais il me manque de la compétence, de la technique
Cliquez pour agrandir...
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:
Vote positif 0 Vote négatif
D

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
 
Vote positif 0 Vote négatif

Discussions similaires

Cédric06400
  • Résolu(e)
XL 2021 Revenir sur Excel
Réponses
6
Affichages
394
Franc58
F
jeff1494
  • Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
276
jeff1494
jeff1494
J
  • Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
70
JJ69
J
B
  • Question
Microsoft 365 Envoi pièce jointe html avec Outlook en VBA
Réponses
5
Affichages
1 K
bennp
B
M
  • Question
Microsoft 365 Joindre une copie de 2 feuilles Excel dans outlook
Réponses
0
Affichages
447
Mika07
M
R
  • Question
envoi mail avec pièce jointe
Réponses
1
Affichages
2 K
fanch55
fanch55
C
  • Question
XL 2019 Envoi mail : Condition dans un HTMLBODY
Réponses
2
Affichages
701
Cheyenne_2021
C
Xtian_Québec
  • Question
XL 2016 vba Envoi de courriel avec Gmail
Réponses
5
Affichages
5 K
kiki29
kiki29
S
  • Question
Microsoft 365 Publipostage de masse avec pièce jointe personnalisé avec outlook
Réponses
1
Affichages
5 K
Sebast6945
S
B
  • Résolu(e)
XL 2016 Selectionner date la plus proche au supérieur de la date d'aujourd'hui
Réponses
5
Affichages
1 K
babacool22
B

Membres actuellement en ligne

1 membres et 41 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 127
Messages
2 116 534
Membres
112 771
dernier inscrit
mikadu49