Prezados, boa tarde!
Planilha está funcionando e em anexo na ultima resposta. Para quem precisar, ela possui código para envio de e-mails automáticos conforme critério de uma tabela anexando documentos correspondentes.
Sempre acompanho o fórum para tirar dicas de Excel e decidi postar minha duvida pois não consegui resolver sozinho.
Objetivo:
Planilha que envia e-mails automaticamente para uma lista de usuários. Eu gostaria de automatizá-la para enviar conforme um critério definido.
Explicação:
Em anexo, está minha planilha. Como não sei bem como fazer, criei um código que possui alguns comentários para esclarecimento. Ela deve funcionar da seguinte maneira:
1. Na aba Macro, possuo o controle nas células F5:G11 que verifico se o vendedor me encaminhou o arquivo de controle.
2. Se o vendedor encaminhou, irá enviar um e-mail conforme a aba Lista (procv) anexando o arquivo no diretório referente ao nome do vendedor;
Segue o código:
Sub EnviaEmail()
'
' EnviaEmail Macro
'
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim StrBody As String
Dim StrBody2 As String
Dim Endereco As String
Dim Endereco2 As String
Dim Titulo As String
Set rng = Nothing
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
' DEFINE Endereço, corpo do e-mail e titulo
StrBody = Sheets("Macro").Range("B3").Value & "<br>" & _
Sheets("Macro").Range("B5").Value & "<br>" & _
Sheets("Macro").Range("B4").Value & "<br>"
StrBody2 = Sheets("Macro").Range("B6").Value & "<br><br>" & _
"<img src='C:Usersleonardogranja-mtzDocumentsAssinatura.png'>"
' como não sei fazer o FOR, vou explicar como eu gostaria:
' nesta linha abaixo, o codigo irá rodar o FOR para todos os valores de F5 a F11, prosseguindo para quando a celular for diferente de 0
for (Sheets("Macro").Range("F5:F11").Value <> 0):
' nas linhas abaixo, o codigo irá fazer um PROCV da celula que está no loop de FOR em outra aba
Endereco = Application.WorksheetFunction.VLOOKUP(Sheets("Macro").Range("F5:F11").Value,Sheets("Lista").Range("A1:B10"),3,)
Endereco2 = Application.WorksheetFunction.VLOOKUP(Sheets("Macro").Range("F5:F11").Value,Sheets("Lista").Range("A1:B10"),3,)
Titulo = "Planilha do " & Sheets("Macro").Range("F5:F11").Value
On Error Resume Next
With OutMail
.To = Endereco
.CC = Endereco2
.BCC = ""
.Subject = Titulo
.HTMLBody = "<FONT FACE=Calibri (Corpo)>" & StrBody & StrBody2
' irá adicionar o anexo com o nome da linha correspondente ao loop de FOR na coluna G
.Attachment = "C:Usersleonardogranja-mtzDocuments" & Sheets("Macro").Range("G5:G11").Value
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
'
End Sub
Fico à disposição.
Muito obrigado!!
Postado : 22/08/2017 2:45 pm