XL 2019 On error et envoi de pièce jointe

'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

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

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

For i = 2 To DLG

 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

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