Eu testei seu código e ele funciona. O que pode estar acontecendo é que está tentando anexar um arquivo que não existe.
O que você pode fazer é adicionar um if
para verificar se o arquivo existe antes de tentar montar o e-mail e exibir uma mensagem para o usuário caso o arquivo não seja encontrado.
Essa verificação pode ser feita usando a função Dir
, como, por exemplo:
Dim CaminhoArquivo As String
CaminhoArquivo = (ThisWorkbook.Path & "\Certificado_" & Cells(lin, 2).Value & ".pptx")
If Dir(CaminhoArquivo) = "" Then ' O arquivo não existe
MsgBox "O arquivo " & CaminhoArquivo & " não existe."
Exit Sub
End If
.Attachments.Add CaminhoArquivo
Código atualizado:
Sub Envia_Emails(EnviarPara As String, Mensagem As String, CaminhoArquivo As String)
Dim OutlookApp As Object
Dim OutlookMail As Object
' Trecho de código adicionado
' <<----------INICIO----------
Dim CaminhoArquivo As String
CaminhoArquivo = ThisWorkbook.Path & "\Certificado_testex.pptx"
If Dir(CaminhoArquivo) = "" Then
MsgBox "O arquivo " & CaminhoArquivo & " não existe."
Exit Sub
End If
' -------------FIM---------->>
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 CaminhoArquivo ' <<--- EDITADO
.Send
End With
Next
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub