Oi Klarc28!
Obrigado pelo link.
Ontem andei pesquisando algumas coisas e consegui fazer o envio do e-mail. Agora, só estou tentando fazer com que no corpo do e-mail apareça as ultimas informações cadastradas.
Já até consegui receber as informações da ultima linha cadastrada das colunas A e B. Mas quando dou sequencia com o mesmo código utilizado, alternando apenas as colunas - não vai. Será que tem alguma outra forma?
obs.: sem falar que quando chega no e-mail, chega tudo junto(sem espaço algum).
Sub email_gmail()
Dim iMsg, Cdo_Conf, Flds
sch = "http://schemas.microsoft.com/cdo/configuration/"
Set Cdo_Conf = CreateObject("CDO.Configuration")
'Variaveis
Dim servidor_smtp As String
Dim conta_autenticada As String
Dim senha_para_envio As String
Dim email_origem As String
Dim email_destino As String
Dim email_porta As Integer
Dim Final As Integer
Dim linha As Integer
'Dim planilha_entrada As Worksheet
For linha = 2 To 5000
If Plan1.Cells(linha, 1) = "" Then
Final = linha
Exit For
End If
Next
'Abaixo seguem algumas definicoes de variaveis para o envio de seu formulario. Por favor preencha os campos abaixo.
servidor_smtp = "smtp.gmail.com" ' Informacoes so seu servidor SMTP
senha_para_envio = "xxxxxxxxx" ' senha da conta de e-mail
email_origem = "alvocabines@gmail.com" ' e-mail que indica de onde partiu a mensagem
email_destino = "henriq.souzasoares@gmail.com" ' e-mail que vai receber as mensagens do formulario
email_assunto = "Sistema Teste" ' Assunto do email
[b]email_corpo = Plan1.Cells(Final - 1, 1) + Plan1.Cells(Final - 1, 2)[/b] ' Corpo do Email
email_porta = 465 ' porta smtp
Cdo_Conf.Fields.Item(sch & "sendusing") = 2
Cdo_Conf.Fields.Item(sch & "smtpauthenticate") = 1
Cdo_Conf.Fields.Item(sch & "smtpserver") = servidor_smtp
Cdo_Conf.Fields.Item(sch & "smtpserverport") = email_porta
Cdo_Conf.Fields.Item(sch & "smtpconnectiontimeout") = 60
Cdo_Conf.Fields.Item(sch & "sendusername") = email_origem
Cdo_Conf.Fields.Item(sch & "sendpassword") = senha_para_envio
Cdo_Conf.Fields.Item(sch & "smtpusessl") = True
Cdo_Conf.Fields.Update
Set Cdo_Mensagem = CreateObject("CDO.Message")
Set Cdo_Mensagem.Configuration = Cdo_Conf
Cdo_Mensagem.BodyPart.Charset = "iso-8859-1"
Cdo_Mensagem.From = email_origem
Cdo_Mensagem.To = email_destino
Cdo_Mensagem.Subject = email_assunto
'------Para anexar arquivo use uma das linguagens abaixo
'Cdo_Mensagem.AddAttachment (ThisWorkbook.Path & "EnvioArquivo das Lojas Envio.xlsm")
'ou
'Cdo_Mensagem.AddAttachment ("C:EnvioArquivo das Lojas Envio.xlsm")
strBody = email_corpo
Cdo_Mensagem.HTMLBody = strBody
Cdo_Mensagem.Send
Set Cdo_Mensagem = Nothing
Set Cdo_Conf = Nothing
MsgBox "E-mail enviado com sucesso"
End Sub
Postado : 19/04/2018 1:48 pm