Skip to main content

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()

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

End Sub Sub Envia_Emails(EnviarPara As String, Mensagem As String) Dim OutlookApp As Object Dim OutlookMail As Object

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")
 >>     .Attachments.Add (ThisWorkbook.Path & "\Certificado_" & Cells(lin, 2).Value & ".pptx")
        .Send
    End With
    
    Next
    
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

End Sub

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

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?

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?

Fonte Link

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?