MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    [Resolvido]Enviar e-mails de contas diferentes no Outlook

    cy_rangel
    cy_rangel
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 38
    Registrado : 18/01/2018

    [Resolvido]Enviar e-mails de contas diferentes no Outlook Empty [Resolvido]Enviar e-mails de contas diferentes no Outlook

    Mensagem  cy_rangel em 11/6/2020, 00:05

    Pessoal,

    Boa-noite.

    Eu tenho o seguinte código abaixo, porém observei que ele gera o e-mail pela caixa secundária, mas quando verifico em itens enviados, está na minha caixa de e-mail principal. Gostaria que o e-mail estivesse de fato nos meus itens enviados da caixa secundária.

    Exemplo: caixa de e-mail (principal): cy_rangel@teste.com.br
                caixa de e-mail (segundária): cy_access@teste.com.br

    Acredito que isso aconteça devido ao parâmetro ".SentOnBehalfOfName".

    Código:
    Public Function fncLerArquivo(ByVal strLocalCorpoEmail As String) As String
    'É NECESSÁRIO ADICIONAR ESSA FUNÇÃO NO INÍCIO ANTES DE QUALQUER CÓDIGO

    Dim objfso As Object
    Dim objts As Object

    On Error Resume Next

    Set objfso = CreateObject("Scripting.FileSystemObject")
    Set objts = objfso.GetFile(strLocalCorpoEmail).OpenAsTextStream(1, -2)
    fncLerArquivo = objts.readall

    objts.Close
    Set objfso = Nothing

    End Function

    Private Sub Btn_Email_Click()

    Dim strLocalBoleto As String
    Dim bolExisteFicheiro As Boolean
    Dim strLocalCorpoEmail As String 'acrescentar essa e a variavel a seguir
    Dim strBody As String

    Dim objOut As Object
    Dim objmail As Object
    Dim objAnexo As Object
    Const olMailItem = 0
    Const olByValue = 1

        Set objOut = CreateObject("Outlook.application")
        Set objmail = objOut.CreateItem(olMailItem)
        Set objAnexo = objmail.Attachments

        With objmail
            .SentOnBehalfOfName = Me!Conta
            .To = Me("E-mail")
            .Subject = Me!Assunto & " - " & Me!Cliente
          
    'Gera o relatório em HTML para adicionar no corpo do e-mail
        strBody = "Dê um nome para o seu relatório" & ".html" 'Chama a variavel nome do arquivo
        strLocalCorpoEmail = CurrentProject.Path & "\Print's" & strBody 'Chama a variavel Local e concatena com o nome do arquivo
        
        DoCmd.OpenReport "NOME DO SEU RELATÓRIO", acViewPreview, , "ID RELATORIO=" & Me!IDFORM, acHidden 'Abre o relatório no registro especifico selecionado no FORM. O 1º nome "ID RELATORIO=" é o nome do campo do seu relatório em Fonte do Controle e o 2º Me!IDFORM é nome do campo do Form (campo "Nome").
        DoCmd.OutputTo acOutputReport, "NOME DO SEU RELATÓRIO", acFormatHTML, strLocalCorpoEmail
        DoCmd.Close acReport, "NOME DO SEU RELATÓRIO" 'Fecha o relatório


    'Add o relatório no corpo do email
        .BodyFormat = olFormatHTML
        .HTMLBody = "<BODY Style = Font-size:11pt;font-family:Calibri> Prezados(as),<br><br>" & fncLerArquivo(strLocalCorpoEmail)
        

            .Save

     
        'Anexa o BOLETO no e-mail
        strLocalBoleto = CurrentProject.Path & "\Print's" & Me("Renomear Boleto") & ".pdf"
        If Dir(strLocalBoleto) = "" Then
            bolExisteFicheiro = True
        
        Else
            bolExisteFicheiro = False
            objAnexo.Add strLocalBoleto, olByValue, 1

        End If
        .Display

    End With

    Set objAnexo = Nothing
    Set objmail = Nothing
    Set objOut = Nothing

    If bolExisteFicheiro Then
        MsgBox "O boleto não foi anexado." & vbNewLine & "Verifique o nome do arquivo ou se ele está salvo no local correspondente."

    End If
    End Sub


    Eu achei o código a seguir na internet, mas consegui faze-lo funcionar apenas no Excel. O código que faz isso nesse exemplo é o "Set OutAccount = OutApp.Session.Accounts.Item"


    Código:
    Sub CriaEmail()

    'Only working in Office 2007 and higher
    'Don't forget to set a reference to Outlook in the VBA editor
        
        Dim OutApp As Outlook.Application 'objOut
        Dim OutMail As Outlook.MailItem
        Dim OutAccount As Outlook.Account
        
        

        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(olMailItem)
        
        'Use the first account, see that Item is 1 now
        Set OutAccount = OutApp.Session.Accounts.Item("cy_access@teste.com.br")
        
        'Or us the name instead of the number
        'Set OutAccount = OutApp.Session.Accounts("ron@something.nl")
        
    On Error Resume Next
        With OutMail
        .To = WrkS.Cells(Celula.Row, 30).Value                   'Coluna Para
        .Subject = WrkS.Cells(Celula.Row, 31).Value              'Coluna Assunto
        .Body = WrkS.Cells(Celula.Row, 32).Value                 'Coluna Corpo do Email
        .Importance = olImportanceHigh
        .SendUsingAccount = OutAccount
        .Display
      
      End With
        On Error GoTo 0

        Set OutMail = Nothing
        Set OutApp = Nothing
        Set OutAccount = Nothing
    End Sub


    Desde já agradeço quem puder ajudar Smile


    Última edição por cy_rangel em 17/6/2020, 22:08, editado 2 vez(es)
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6957
    Registrado : 15/03/2013

    [Resolvido]Enviar e-mails de contas diferentes no Outlook Empty Re: [Resolvido]Enviar e-mails de contas diferentes no Outlook

    Mensagem  ahteixeira em 15/6/2020, 09:48

    Olá Cinthia,

    O ideal e mais simples seria enviar via CDO, não falta exemplos no forum, veja como fazer uma "Busca":
    https://www.maximoaccess.com/t1115-busca-no-forum-search

    Caso pretenda através do Outlook não sei como tem configurado o email secundário ou se tem outro perfil, no entanto veja se ajuda:
    slipstick.com/developer/code-samples/send-email-address-vba/

    Abraço
    cy_rangel
    cy_rangel
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 38
    Registrado : 18/01/2018

    [Resolvido]Enviar e-mails de contas diferentes no Outlook Empty Re: [Resolvido]Enviar e-mails de contas diferentes no Outlook

    Mensagem  cy_rangel em 16/6/2020, 23:08

    Olá ahteixeira,

    Obrigada pelo retorno.

    Eu tente, e tentei muito, de verdade... Tentei com o código que você enviou, com o cód a seguir do moderador JP e com o do Avelino, consegui fazer todos eles funcionarem sem dar erro, mas depois que eu envio, quando consulto em "Enviados" está na minha caixa de email principal e não na secundária.

    Não sei se tem haver com o meu e-mail ser Exchange (Outlook), eu não consigo compreender Sad Sad Sad

    https://www.maximoaccess.com/t9717-resolvidoinserir-campo-de-fromremetente-para-enviar-email-via-codigo-usando-o-outlook
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6957
    Registrado : 15/03/2013

    [Resolvido]Enviar e-mails de contas diferentes no Outlook Empty Re: [Resolvido]Enviar e-mails de contas diferentes no Outlook

    Mensagem  ahteixeira em 16/6/2020, 23:30

    Olá,

    A) E quem recebe o email, veio do email principal ou secundario?

    B) Como tem configurado o email secundario, pode mostrar foto das configurações do outlook (removendo os dados pessoais) para compreender melhor o que tem.

    C) o problema está na mensagem enviada estar nos enviados da conta principal?

    Abraço
    cy_rangel
    cy_rangel
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 38
    Registrado : 18/01/2018

    [Resolvido]Enviar e-mails de contas diferentes no Outlook Empty Re: [Resolvido]Enviar e-mails de contas diferentes no Outlook

    Mensagem  cy_rangel em 17/6/2020, 02:43

    Olá, obg mesmo por tentar ajudar... Seguem as respostas:

    A) Quem recebe, recebe do e-mail correto (secundário).

    B) Me fala a tela q vc quer ver, onde tenho que entrar, então eu printo e posto.

    C) Exato, a mensagem enviada não vai para a caixa secundária, ela fica nos enviados da principal. Se não tiver jeito, pensei em deixar como está, uma vez que o destinatário recebe pela conta correta (a secundária) então eu coloco uma regra dentro do Outlook para enviar o e-mail a caixa de enviados da conta secundária, rs... Não é o mundo ideal, mas é uma opção :/

    Até logo...
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6957
    Registrado : 15/03/2013

    [Resolvido]Enviar e-mails de contas diferentes no Outlook Empty Re: [Resolvido]Enviar e-mails de contas diferentes no Outlook

    Mensagem  ahteixeira em 17/6/2020, 09:48

    Olá Cinthia,

    Para ver as configurações, abre o Outlook e vai a Ficheiro -> Informações - > Definições da conta.
    Mas não é necessário, pois seguramente tem duas contas de email configuradas com dois ficheiros de dados (xxx.ost).

    A solução que optou já tinha pensado nela e creio ser a mais simples e correta.

    Não tenho experiência nessa área mas é possível fazer através do MSAccess activando a referencia "Microsoft Outlook xx.xx Object Library".

    Veja se ajuda:
    slipstick.com/developer/code-samples/copy-message-another-folder/
    docs.microsoft.com/en-us/office/vba/api/outlook.mailitem.move


    Abraço
    cy_rangel
    cy_rangel
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Feminino
    Localização : Brasil
    Mensagens : 38
    Registrado : 18/01/2018

    [Resolvido]Enviar e-mails de contas diferentes no Outlook Empty Re: [Resolvido]Enviar e-mails de contas diferentes no Outlook

    Mensagem  cy_rangel em 17/6/2020, 22:03

    Olá ahteixeira,

    Consegui Smile ... Não será necessário aplicar a regra, consegui fazer funcionar. Vou deixar a dica abaixo para alguém mais que precisar.

    a variável "Dim objOut As Object" precisa ser > Dim objOut As Outlook.Application
    a variável "Dim objmail As Object" precisa ser > Dim objmail As Outlook.MailItem
    Adicionar a variável "Dim OutAccount As Outlook.Account"
    "Dim strEmailFrom As String". Não é necessário, mas eu adicionei para ler direto do meu formulário no campo correspondente, onde terá o e-mail From, assim qualquer usuário pode alterar

    Antes de "With objMail", adicionar:
        strEmailFrom = Me!Conta Variavel que indica o campo correspondente dentro do formulário (se não quiser, é só excluir essa linha e apagar o 4º item)
        Set OutAccount = objOut.Session.Accounts.Item(strEmailFrom) se apagar o 4º item e a linha de cima, substituir "(strEmailFrom)" pelo e-mail da conta, exemplo ("cy_rangel@emailsecudario.com.br")

    adicionar depois de Subjet > .SendUsingAccount = OutAccount 'From

    PS.: Os e-mails que possuo são todos Exchange e uso o app do Outlook instalado direto na minha máquina. Li em muitos lugares dizendo que quem possui conta "Exchange" no 6º passo (explicado acima) é necessário usar o ".SentOnBehalfOfName", mas acho que não é bem assim, pois no meu caso o ".SendUsingAccount" funcionou perfeitamente (.SendUsingAccount recomendava utlizar em contas Pop3 ou Imap).


    Deixo também o código completo ajustado (os campos que eu mexi e mencionei, eu deixei com "recuo" para facilitar o entendimento):

    Código:
    Public Function fncLerArquivo(ByVal strLocalCorpoEmail As String) As String
    'É NECESSÁRIO ADICIONAR ESSA FUNÇÃO NO INÍCIO ANTES DE QUALQUER CÓDIGO

    Dim objfso As Object
    Dim objts As Object

    On Error Resume Next

    Set objfso = CreateObject("Scripting.FileSystemObject")
    Set objts = objfso.GetFile(strLocalCorpoEmail).OpenAsTextStream(1, -2)
    fncLerArquivo = objts.readall

    objts.Close
    Set objfso = Nothing

    End Function

    Private Sub Btn_Email_Click()

    Dim strLocalBoleto As String
    Dim bolExisteFicheiro As Boolean
    Dim strLocalCorpoEmail As String 'acrescentar essa e a variavel a seguir
    Dim strBody As String

            Dim objOut As Outlook.Application 'declaração da variável para a função SET
            Dim objmail As Outlook.MailItem 'declaração da variável para a função SET
            Dim OutAccount As Outlook.Account
            Dim strEmailFrom As String 'declaração da variável para a função SET OutAccount
    Dim objAnexo As Object

    Const olMailItem = 0
    Const olByValue = 1

    Set objOut = CreateObject("Outlook.application")
    Set objmail = objOut.CreateItem(olMailItem)
    Set objAnexo = objmail.Attachments

            strEmailFrom = Me!Conta 'Variavel que indica o campo correspondete a conta
            Set OutAccount = objOut.Session.Accounts.Item(strEmailFrom)
        
    With objmail
    .SentOnBehalfOfName = Me!Conta
    .To = Me("E-mail")
    .Subject = Me!Assunto & " - " & Me!Cliente
            .SendUsingAccount = OutAccount 'Para ou From
          
    'Gera o relatório em HTML para adicionar no corpo do e-mail
    strBody = "Dê um nome para o seu relatório" & ".html" 'Chama a variavel nome do arquivo
    strLocalCorpoEmail = CurrentProject.Path & "\Print's" & strBody 'Chama a variavel Local e concatena com o nome do arquivo
        
    DoCmd.OpenReport "NOME DO SEU RELATÓRIO", acViewPreview, , "ID RELATORIO=" & Me!IDFORM, acHidden 'Abre o relatório no registro especifico selecionado no FORM. O 1º nome "ID RELATORIO=" é o nome do campo do seu relatório em Fonte do Controle e o 2º Me!IDFORM é nome do campo do Form (campo "Nome").
    DoCmd.OutputTo acOutputReport, "NOME DO SEU RELATÓRIO", acFormatHTML, strLocalCorpoEmail
    DoCmd.Close acReport, "NOME DO SEU RELATÓRIO" 'Fecha o relatório


    'Add o relatório no corpo do email
    .BodyFormat = olFormatHTML
    .HTMLBody = "<BODY Style = Font-size:11pt;font-family:Calibri> Prezados(as),<br><br>" & fncLerArquivo(strLocalCorpoEmail)
        

    .Save
     
    'Anexa o BOLETO no e-mail
    strLocalBoleto = CurrentProject.Path & "\Print's" & Me("Renomear Boleto") & ".pdf"
    If Dir(strLocalBoleto) = "" Then
    bolExisteFicheiro = True
        
    Else
    bolExisteFicheiro = False
    objAnexo.Add strLocalBoleto, olByValue, 1

    End If
    .Display

    End With

    Set objAnexo = Nothing
    Set objmail = Nothing
    Set objOut = Nothing

    If bolExisteFicheiro Then
    MsgBox "O boleto não foi anexado." & vbNewLine & "Verifique o nome do arquivo ou se ele está salvo no local correspondente."

    End If
    End Sub

    Até a próxima e muito obrigada pela ajuda AHTeixeira \o/
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6957
    Registrado : 15/03/2013

    [Resolvido]Enviar e-mails de contas diferentes no Outlook Empty Re: [Resolvido]Enviar e-mails de contas diferentes no Outlook

    Mensagem  ahteixeira em 17/6/2020, 23:10

    Olá Cinthia,

    Fico feliz por ter conseguido, Parabéns!
    Obrigado pelo retorno e partilha do código, o fórum agradece.

    Abraço

      Data/hora atual: 2/12/2020, 13:06