-4

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?

1
  • Por favor, esclareça seu problema ou forneça detalhes adicionais a fim de destacar exatamente o que você precisa. Da forma como está escrito atualmente é difícil dizer com exatidão o que você está perguntando.
    – Comunidade Bot
    Commented 16/09/2021 às 13:48

1 Resposta 1

0

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 & "\nome_arquivo.pptx"
    
If Dir(CaminhoArquivo) = "" Then
    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
    Dim CaminhoArquivo As String
        
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    
    For lin = 1 To 2
        CaminhoArquivo = (ThisWorkbook.Path & "\Certificado_" & Cells(lin, 2).Value & ".pptx")
    
        If Dir(CaminhoArquivo) = "" Then
            MsgBox "O arquivo '" & CaminhoArquivo & "' não existe e o e-mail não será enviado.", vbCritical
        Else
             With OutlookMail
                .to = EnviarPara
                .CC = ""
                .BCC = ""
                .Subject = "Teste"
                .Body = Mensagem & Chr(10) & Chr(10) & "Atenciosamente"
                .Attachments.Add CaminhoArquivo
                .Send
            End With
            
            MsgBox "Email enviado com o arquivo '" & CaminhoArquivo & "' como anexo.", vbInformation
        End If
    Next
    
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

Você deve fazer log-in para responder a esta pergunta.

Esta não é a resposta que você está procurando? Pesquise outras perguntas com a tag .