XL 2016 recuperer un fichier pdf et l'envoyer

[nettoyageduperche]

bonjour
je souhaite envoyer par mail des bulletin de paie de façon automatisé.
je suis bloqué, car je n'arrive pas a recuperer le fichier pdf qui porte le meme nom que le collaborateur concerné.
je vous joint le fichier avec mon code.
Le chemin est le bon car je l'ai verifier en indiquant le nom du pdf a recuprer a la place de "activcell"
par avance merci pour aide

 

[kiki29]

Salut, cela devrait suffire

Option Explicit

Sub CommandButton1_Click()
Dim LeMail As Variant
Dim AdresseMail As String
Dim olMailItem As Variant, sFichier As String
    Set LeMail = CreateObject("outlook.Application")

    AdresseMail = ActiveCell.Offset(0, 10)

    If AdresseMail <> Empty Then
        With LeMail.CreateItem(olMailItem)
            .Subject = "Votre bulletin de salaire"
            .To = AdresseMail
            .HTMLBody = "bonjour " & "<br>" & "Ci-joint votre buletin de paie"
            .Display

            sFichier = ThisWorkbook.Path & "\" & "Test.pdf"
            .Attachments.Add (sFichier)
            .Send
        End With
    Else
        MsgBox "le client ne dispose pas d'adresse mail"
    End If
    Set LeMail = Nothing
End Sub

 

[nettoyageduperche]

Bonjour KIKI et merci, mais j'ai ce message lorsque j'arrive a la ligne attachment

 

[kiki29]

Re, ?

sFichier = "F:\taf\salaire\salaire nettoyage du perche\salaire ndp 06 2020\" & ActiveCell.Offset(0, 11) & ".pdf"

 

[nettoyageduperche]

toujour la meme erreur

 

[kiki29]

Re, le message d'erreur est explicite ! J'ai ajouté une fonction ExistenceFichier pour cela. A toi d'adapter à ton contexte le contenu de sFichier, en plus de l'utilisation d'intersect pour cerner la zone des noms.

Spoiler

sFichier = ThisWorkbook.Path & "\" & "Test.pdf"

Option Explicit

Sub CommandButton1_Click()
Dim LeMail As Variant
Dim AdresseMail As String
Dim olMailItem As Variant, sFichier As String
Dim inter As Range, LastRow As Long

    Feuil1.Activate
    Set LeMail = CreateObject("outlook.Application")
    AdresseMail = ActiveCell.Offset(0, 10)

    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    Set inter = Application.Intersect(Feuil1.Range(ActiveCell.Address), Feuil1.Range("A2:A" & LastRow))
    If inter Is Nothing Then
        MsgBox "Sélectionnez une cellule valide dans la 1ere colonne !", vbOKOnly + vbCritical
        Set inter = Nothing
        Set LeMail = Nothing
        Exit Sub
    End If
    Set inter = Nothing

    If AdresseMail <> Empty Then
        sFichier = ThisWorkbook.Path & "\" & "Test.pdf"
        If ExistenceFichier(sFichier) = False Then
            MsgBox "Fichier : " & sFichier & vbCrLf & "Inexistant !", vbOKOnly + vbCritical
            Set LeMail = Nothing
            Exit Sub
        End If
        With LeMail.CreateItem(olMailItem)
            .Subject = "Votre bulletin de salaire"
            .To = AdresseMail
            .HTMLBody = "Bonjour, " & "<br>" & "Ci-joint votre bulletin de salaire"
            .Display
            .Attachments.Add (sFichier)
            .Send
        End With
    Else
        MsgBox "Le client ne dispose pas d'une adresse mail"
    End If
    Set LeMail = Nothing
End Sub

Private Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir$(sFichier) <> "" And sFichier <> ""
End Function

 

[kiki29]

Re, avec une gestion d'erreur sommaire

Option Explicit

Sub CommandButton1_Click()
Dim LeMail As Variant
Dim AdresseMail As String
Dim MailItem As Variant, sFichier As String
Dim Inter As Range, LastRow As Long

    Feuil1.Activate
    Set LeMail = CreateObject("outlook.Application")
    AdresseMail = ActiveCell.Offset(0, 10)

    LastRow = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
    Set Inter = Application.Intersect(Feuil1.Range(ActiveCell.Address), Feuil1.Range("A2:A" & LastRow))
    If Inter Is Nothing Then
        MsgBox "Sélectionnez une cellule valide dans la 1ere colonne !", vbOKOnly + vbCritical
        Set Inter = Nothing
        Set LeMail = Nothing
        Exit Sub
    End If
    Set Inter = Nothing

    If AdresseMail <> Empty Then
        sFichier = ThisWorkbook.Path & "\" & "Test.pdf"
        If ExistenceFichier(sFichier) = False Then
            MsgBox "Fichier : " & sFichier & vbCrLf & "Introuvable !", vbOKOnly + vbCritical, "Fichier introuvable"
            Set LeMail = Nothing
            Exit Sub
        End If
        On Error GoTo Erreurs
        With LeMail.CreateItem(MailItem)
            .Subject = "Votre bulletin de salaire"
            .To = AdresseMail
            .HTMLBody = "Bonjour, " & "<br>" & "Ci-joint votre bulletin de salaire"
            '.Display
            .Attachments.Add (sFichier)
            .Send
        End With
    Else
        MsgBox "Ce client ne dispose pas d'une adresse mail", vbOKOnly + vbCritical, "Pas d'adresse Mail"
    End If
    Exit Sub

Erreurs:
    If (Not (LeMail Is Nothing)) Then Set LeMail = Nothing
    MsgBox "Le mail n'a pas été envoyé !", vbOKOnly + vbCritical, "Envoi avorté"
End Sub

Private Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir$(sFichier) <> "" And sFichier <> ""
End Function