Segue ai amigo
Claro que da pra fazer muitas melhorias, e este exemplo é para contas G-MAIL, tenho aqui opcoes para envio pelo Outlook bem complexos que eu teria que tirar bastante coisa pra se moldar a vc, pois todas as minhas macros sao personalizadas a meu gosto.
Agradeço a todos deste forum que sempre me acolheu e me ajuda no que pode.
Andre
Sub Enviar()
If Range("C2").Value = Range("D2").Value Then
Run "Feliz_Aniversario"
Else: End If
End Sub
Sub Feliz_Aniversario()
'-------------------------------------------------
'Enviar Email
'-------------------------------------------------
'Baseado no código disponibilizado em: http://www.a1vbcode.com/snippet-3691.asp
'Function EnviaEmail2()
Dim iMsg, iConf, Flds
'Seta as variáveis, lembrando que o objeto Microsoft CDO deverá estar habilitado em Ferramentas->Referências->Microsoft CDO for Windows 2000 Library
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
'Configura o componente de envio de email
schema = "http://schemas.microsoft.com/cdo/configuration/"
Flds.Item(schema & "sendusing") = 2
'Configura o smtp
Flds.Item(schema & "smtpserver") = "smtp.gmail.com"
'Configura a porta de envio de email
Flds.Item(schema & "smtpserverport") = 465
Flds.Item(schema & "smtpauthenticate") = 1
'Configura o email do remetente
Flds.Item(schema & "sendusername") = "vendasenergyrj@gmail.com"
'Configura a senha do email remetente
Flds.Item(schema & "sendpassword") = "am861485"
Flds.Item(schema & "smtpusessl") = 1
Flds.Update
Dim Cliente As String
Cliente = Range("xxx") ' Digite aqui a Celula ondee se encontra o nome de seu Clienete ex> Sheet("planilha tal").Range("Celula tal").Value
With iMsg
'Email do destinatário
.To = Cliente
'Seu email
.From = "SEU EMAIL" 'Digite aqui seu Email
'Título do email
.Subject = "Obrigado, Suplementos FazerBem"
'Mensagem do e-mail, você pode enviar formatado em HTML
' ou
.HTMLBody = "Caro Cliente, " & Range("L6").Value & "<br><br>" & _
"Obrigado por comprar conosco !" & "<br>" & _
"Volte sempre, e não se esqueça de nos indicar !" & "<br><br>" & _
"Dra. Flávia Roberge é a Nutricionista Esportiva que atende na Suplementos FazerBem, marque já a sua consulta !" & "<br><br>" & _
"Atenciosamente, Fulano de tal" & "<br>" & _
"Seu endereço caso queira colocar de seu negocio" & "<br>" & _
"Fone: " & "<br>" & _
"Whatsapp/Telegram: (21) xxxxxxxxx" & "<br><br>" & _
"Seu Site" & "<br><br>"
'Seu nome ou apelido
.Sender = "SEU NOME OU EMPRESA"
'Nome da sua organização
.Organization = "SUA ORGANIZACAO SE QUISER POR"
'email de responder para
.ReplyTo = "responder para seu email tal"
'Anexo a ser enviado na mensagem
' .AddAttachment ("c:fatura.txt")
'Passa a configuração para o objeto CDO
Set .Configuration = iConf
'Envia o email
.Send
End With
'Limpa as variáveis
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
'End Function
'--------------------------------------------------------------------
End Sub
Postado : 29/09/2016 5:15 am