none
Macro = Enviar conteúdo da ABA por e-mail RRS feed

  • Pergunta

  • Boa Tarde.

    No código abaixo eu estou enviando o arquivo em anexo. Como que eu faço para enviar o conteúdo da aba ou um intervalo de celulas ?

    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

     

    '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 = "xxxxxx" ' senha da conta de e-mail
    email_origem = "teste@teste.com.br" ' e-mail que indica de onde partiu a mensagem
    email_destino = "teste@teste.com.br" ' e-mail que vai receber as mensagens do formulario
    email_assunto = "Teste" ' Assunto do email
    email_corpo = "Deu certo meu " ' 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 & "\Envio\Arquivo das Lojas Envio.xlsm")
       'ou
    'Cdo_Mensagem.AddAttachment ("C:\Envio\Arquivo 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

    sexta-feira, 19 de janeiro de 2018 18:33

Todas as Respostas

  • Tente o fórum "Planilhando". Lá é possível anexar arquivo e também há mais pessoas para responder.

    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    sábado, 20 de janeiro de 2018 10:17