Skip to main content

VBA- Como mandar email automáticos com pptx/pdf em anexo

Estou com esse código para enviar email com um arquivo em PPTX ou PDF para uma lista de pessoas, e ele para dizendo que não encontrou o arquivo. Notem que referenciei parte do nome do arquivo com uma celula que contém uma variável para que ele consiga mandar outro email sozinho.

Sub MandaEmail()
    
    Dim EnviarPara As String
    Dim Mensagem As String
 
    For i = 1 To 10
        EnviarPara = ThisWorkbook.Sheets(1).Cells(i, 1)
        If EnviarPara <> "" Then
            Mensagem = ThisWorkbook.Sheets(1).Cells(i, 3)
            Envia_Emails EnviarPara, Mensagem
        End If
    Next i
End Sub
Sub Envia_Emails(EnviarPara As String, Mensagem As String)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
 
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    
    For lin = 1 To 2
    With OutlookMail
        .to = EnviarPara
        .CC = ""
        .BCC = ""
        .Subject = "Teste"
        .Body = Mensagem & Chr(10) & Chr(10) & "Atenciosamente" 
 >>     .Attachments.Add (ThisWorkbook.Path & "\Certificado_" & Cells(lin, 2).Value & ".pptx")
        .Send
    End With
    
    Next
    
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

o problema acontece no Attachments.Add alguém pode ajudar?