Enviar e-mail via Outlook de conta secundária

Visual Basic for Aplication e macros no Excel.
Regras do fórum
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde. Imagem

Enviar e-mail via Outlook de conta secundária

Mensagempor rogbrand » Qua Jul 17, 2019 10:39 am

Bom dia pessoal,

Preciso de uma ajuda... Posso negociar até um valor pelo código...

Vamos lá!

Preciso criar uma planilha para envio de e-mails em massa, cuja mensagem seja enviada a partir da conta secundária do Outlook.

A ideia é que o e-mail do destinatário, nome e outros dados venham da planilha. O corpo do e-mail (texto), venha de um arquivo formatado previamente do Word.

Não sei se isso é possível... Então, fica aqui o desafio se alguém souber...

No aguardo..

Rogério.
rogbrand
Membro
Membro
 
Mensagens: 21
Registrado em: Qua Ago 01, 2012 8:22 pm
Has thanked: 6 times
Have thanks: 0 time

{ SO_SELECT }

Re: Enviar e-mail via Outlook de conta secundária

Mensagempor wagner » Qua Jul 17, 2019 1:52 pm

rogbrand,

Boa tarde!

Desculpe aí mas... para os leigos aqui como eu... o que você chama de "conta secundária do Outlook"?
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 5501
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 100 times
Have thanks: 2331 times

Re: Enviar e-mail via Outlook de conta secundária

Mensagempor rogbrand » Qua Jul 17, 2019 3:47 pm

Tenho a conta pessoal e a caixa que acessamos no grande grupo do setor...

pessoal = rogerio.brand@.....com.br
secundária = credenciamento@....com.br
rogbrand
Membro
Membro
 
Mensagens: 21
Registrado em: Qua Ago 01, 2012 8:22 pm
Has thanked: 6 times
Have thanks: 0 time

Re: Enviar e-mail via Outlook de conta secundária

Mensagempor wagner » Qua Jul 17, 2019 4:27 pm

rogbrand,

Boa tarde!

A função abaixo serve para você enviar uma mensagem (veja a rotina Teste que chama a função para enviar a mensagem de acordo com os parâmetros que são necessários na função).

Obviamente, se você precisa pegar em uma coluna da planilha, vários destinatários, você precisa criar na rotina Teste ou outro qualquer nome que você dê, um laço de repetição para que o código varra toda a coluna e pegue cada um dos dados que você pretende enviar. Isso é bem simples e fácil de fazer.

Quanto a questão de enviar mensagens previamente formatadas no Word, creio que uma das formas de fazer isso é você preparar arquivos e no email mandar apenas uma mensagem padrão da remessa dos arquivos como anexo de email. Para anexar os arquivos você informa no parâmetro ArquivoAnexo, o caminho do arquivo completo, com o nome do arquivo que você quer enviar.
Código: Selecionar todos
Function EnviaCorreio(Remetente As String, Destinatário As String, CC As String, CCO As String, ArquivoAnexo As String, Assunto As String, Mensagem As String)
   
    Dim OutApp As Object
    Dim OutMail As Object
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
   
    With OutMail
        .SentOnBehalfOfName = Remetente '(Use aqui a conta secundária)
        .To = Destinatário
        .CC = CC
        .BCC = CCO
        .Subject = Assunto
        .Body = Mensagem
        '.Attachments.Add ArquivoAnexo
        .Display 'Use display apenas para testar e visualizar o email. Se quiser enviar sem visualizar, use o .Send
        '.Send
    End With
End Function
Sub teste()
    Call EnviaCorreio("credenciamento@....com.br", "marcos@hotmail.com", "roberto.cesar@yahoo.com.br", "pedro_alves@hmail.com", "", "Teste", "Esse é um teste de envio de mensagem")
End Sub
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel

For this post the author wagner thanked:
rogbrand (Qui Jul 18, 2019 9:53 am)
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 5501
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 100 times
Have thanks: 2331 times

Re: Enviar e-mail via Outlook de conta secundária

Mensagempor rogbrand » Qui Jul 18, 2019 9:52 am

Grato pela ajuda, Wagner!

Consegui com a tua ajuda fazer com que o e-mail saia da caixa secundária e também anexe arquivos... mas, ainda vou precisar de alguma forma fazer com que o corpo do e-mail seja em html, que me possibilite formatar... Já é complicado fazer as pessoas lerem todo o texto, colorido, com font extra e tal, anexo? eles nem sabem o que é isso... :(

Sigo tentando... Valeu pela ajuda...
rogbrand
Membro
Membro
 
Mensagens: 21
Registrado em: Qua Ago 01, 2012 8:22 pm
Has thanked: 6 times
Have thanks: 0 time

Re: Enviar e-mail via Outlook de conta secundária

Mensagempor wagner » Qui Jul 18, 2019 1:09 pm

rogbrand,

Boa tarde!

Infelizmente o site não está permitindo anexar arquivos. No código abaixo, estou te enviando uma rotina que faz isso que você quer (mandar email com formatação em HTML). Você deve fazer as necessárias adaptações ao código que já te enviei e o que você fez por aí de modo a conseguir intercalar com essa abaixo que envia mensagens formatadas em html.

Código: Selecionar todos
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim rng As Range
    Dim UltimaLinha As Long
    Dim objApp As Object, Novo_Email As Object
    Dim sbObj As Scripting.FileSystemObject
    Dim vlor_text As Scripting.TextStream
    Dim stHTMLBody As String

   
    If Target.Count > 1 Then
        Application.EnableEvents = True
        Exit Sub
    End If
   
    If Target.Column = 9 And Target.Row > 1 Then
        If Target.Value = "ok" Then
            UltimaLinha = Sheets("Apoio").Cells(Cells.Rows.Count, 1).End(xlUp).Row
            If UltimaLinha < 2 Then UltimaLinha = 2
           
            Sheets("Apoio").Visible = -1
            Sheets("Apoio").Select
            Sheets("Apoio").Rows("2:" & UltimaLinha).Select
            Selection.Delete Shift:=xlUp
            Sheets("Apoio").Range("A1").Select
           
            Sheets("PENDENTE").Select
            Range("B" & Target.Row & ":H" & Target.Row).Select
            Selection.Copy
            Sheets("Apoio").Select
            Sheets("Apoio").Range("A2").Select
            ActiveSheet.Paste
            Sheets("Apoio").Range("A2").Select
            Sheets("PENDENTE").Select
            Application.CutCopyMode = False
            Sheets("PENDENTE").Range("B1").Select
           
            UltimaLinha = Sheets("Apoio").Cells(Cells.Rows.Count, 1).End(xlUp).Row
       
            Set rng = Sheets("Apoio").Range("A1:H" & UltimaLinha + 1)
           
           
            On Error GoTo 0
           
           
           
            'HTML-File cria um arquivo htm temporario
            ActiveWorkbook.PublishObjects. _
                Add(xlSourceRange, ActiveWorkbook.Path & "\temp.htm", rng.Parent.Name, rng.Address, _
                xlHtmlStatic).Publish True
           
            Sheets("Apoio").Visible = 2
           
            'cria uma nova seção no outlook para envio
            Set objApp = CreateObject("Outlook.Application")
            Set Novo_Email = objApp.CreateItem(0)
           
            'Abre HTML-file o arquivo Htm para inserção no texto do outlook via FIleSystemObject Textvlor_text objeto.
            Set sbObj = New Scripting.FileSystemObject
            Set vlor_text = sbObj.OpenTextFile(ActiveWorkbook.Path & "\temp.htm", ForReading)
           
            stHTMLBody = vlor_text.ReadAll
           
            With Novo_Email
                .To = "email_recebedor"
                .CC = ""
                .BCC = ""
                .Subject = "Titulo do email"
                .HTMLBody = stHTMLBody
                .Display
            End With
        End If
           
        Set Novo_Email = Nothing
        Set sbObj = Nothing
        Set objApp = Nothing
       
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Se a resposta foi útil para você, por gentileza, Amigo, clique na mãozinha ao lado direito da ferramenta CITAR, no canto superior direito.

Atenciosamente
Wagner Morel
Avatar do usuário
wagner
Moderador
Moderador
 
Mensagens: 5501
Registrado em: Sáb Out 20, 2012 12:49 pm
Localização: Fortaleza - CE
Has thanked: 100 times
Have thanks: 2331 times


Voltar para VBA & Macros

Quem está online

Usuários navegando neste fórum: Nenhum usuário registrado e 2 visitantes