Fórum Envio de e-mail com anexos #535747

'Sub Enviar_Email(Dest As String, Copia As String, Nome As String, AnexItem As String)
Sub Enviar_Email(Dest As String, Copia As String, Nome As String, Usuario As String)

'declara variaveis
Dim Assunto As String, Msg As String ', AnexPath As String

'atribui assunto
Assunto = Range("assunto")

'atribui mensagem
Msg = Range("mensagem")

'atribui caminhos dos anexos
'AnexPath = Range("anexos") & "\" & AnexItem



'verifica se o arquivo existe
'Set fs = CreateObject("Scripting.FileSystemObject")
'Set a = fs.fileexists(AnexPath)

'inclui o nome de destinatario na mensagem
Assunto = Replace(Assunto, "<%Nome%>", Nome)
Msg = Replace(Msg, "<%Usuario%>", Usuario)

'inicia objeto de email do Outlook
Dim oApp As Outlook.Application
Dim oMailItem As Outlook.MailItem

Set oApp = CreateObject("Outlook.Application")
Set oMailItem = oApp.CreateItem(olMailItem)

With oMailItem

    .Subject = Assunto
    .Body = Msg
    .To = Dest
    .CC = Copia
    'If Dir(AnexPath) <> "" Then .Attachments.Add (AnexPath)
    .Attachments.Add "C:\Users\NAC\Desktop\anexo1.pdf"
    .Attachments.Add "C:\Users\NAC\Desktop\anexo2.pdf"
    .Send
    
End With


End Sub

Sub Enviar_Tudo()

x = 2
Do Until Range("A" & x) = ""
    Enviar_Email Range("B" & x), Range("C" & x), Range("A" & x), Range("D" & x)
    'Enviar_Email Range("B" & x), Range("C" & x), Range("A" & x), Range("D" & x)
    x = x + 1
Loop

End Sub