En VBA, problème de pièce jointe lors d'un envoi automatique

Bonjour,

Je suis en train de me mettre aux macros, et pour l'instant je reprends des morceaux de code qui ont été écrits par un collègue.

Mon but est de pouvoir faire envoyer automatiquement des mails à une liste de destinataires avec une pièce jointe personnalisée en format PDF.

Les pièces jointes sont enregistrées dans un dossier sur le bureau (Est ce que ça change quelque chose si les documents sont enregistrés sur le réseau commun dans des dossiers qui me sont propres?). Les noms des documents sont enregistrés dans une liste qui associe le destinataire à son document (pièce jointe)

La macro fonctionne partiellement, elle génère les mails avec les adresses et le bon message. Mais la pièce jointe ne s'attache pas et le mail n'est pas expédié.

Je vous joins ci dessous le code de la macro et en pièce jointe l'onglet "Liste de diffusion" auquel la macro fait référence.

Je vous remercie par avance des réponses que vous voudrez bien me donner et du temps que vous consacrerez à ma demande,

J'espère avoir transmis toutes le s informations nécessaires.

Sub mailPDF()

Dim ObjOutlook As New Outlook.Application
Dim oBjMail
Dim Nom_Fichier1 As String
Dim i As Integer
Dim lastrow As Integer
Dim statutPrat As String
Dim sendType As Boolean

    sendType = Sheets("Liste de diffusion").Range("O2").Value

    Set ObjOutlook = New Outlook.Application
    lastrow = Sheets("Liste de diffusion").Range("A10000").End(xlUp).Row

    For i = 2 To lastrow

    Set oBjMail = ObjOutlook.CreateItem(olMailItem)
    On Error GoTo suite

        Nom_Fichier1 = Sheets("Liste de diffusion").Range("H" & i).Value

        With oBjMail
            .Display
            .To = Sheets("Liste de diffusion").Range("F" & i).Value
            .Subject = "Activité libérale"
            .HTMLBody = Sheets("Liste de diffusion").Range("J" & i).Value & "<br><br>" & _
                Sheets("Liste de diffusion").Range("K" & i).Value & "<br><br>" & _
                Sheets("Liste de diffusion").Range("L" & i).Value & _
                .HTMLBody
            .Attachments.Add TempFilePath & TempFileName & "\\naschlb\Donnees\Profils\mon nom\Bureau\Envoi\" & Nom_Fichier1
            If Not sendType = False Then .Send
        End With
        Sheets("Liste de diffusion").Range("M" & i).Value = "Envoi réussi"
        GoTo suite2

        If Nom_Fichier1 = "" Then Exit Sub

suite:
    Sheets("Liste de diffusion").Range("M" & i).Value = "Echec envoi"
    On Error GoTo -1
suite2:

    Set oBjMail = Nothing
    Next i

    Set ObjOutlook = Nothing

End Sub

Bonsoir,

je vois 2 raisons possibles pour lesquelles les mails ne sont pas envoyés.

1) la cellule O2 ne contient pas VRAI

2) le chemin d'accès vers chacune des pièces jointes n'est pas correct.

dans cette instruction

TempFilePath & TempFileName & "\\naschlb\Donnees\Profils\mon nom\Bureau\Envoi\" & Nom_Fichier1

si tempfilepath et /ou TempfileName contien(nen)t quelque chose le chemin est incorrect, s'ils ne contiennent rien, elles n'ont pas lieu d'être dans l'instruction. de plus je pense qu'il faut compléter cette instruction avec l'extension du fichier (& ".pdf") ou autre suivant le type de pièce jointe

Bonsoir,

Merci beaucoup pour votre réponse très rapide.

Je teste ça dès demain matin, mais je parierais sur la valeur de la cellule O2.

Bonsoir,

en fait à la relecture du code, voici :

pas d'envoi, mais malgré tout message "envoi réussi" -> cause cellule O2 ne contient pas VRAI

pas d'envoi et message "envoi échoué", -> cause une erreur s'est produite, (fort probablement un problème de fichier non trouvé ou invalide).