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

    Envio de e-mail pelo Outlook não respeita conta selecionada no codigo VBA

    avatar
    carniel.ass.info
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 49
    Registrado : 14/09/2012

    Envio de e-mail pelo Outlook não respeita conta selecionada no codigo VBA Empty Envio de e-mail pelo Outlook não respeita conta selecionada no codigo VBA

    Mensagem  carniel.ass.info em 29/4/2020, 00:30

    Caros colaboradores boa noite;

    Estou desenvolvendo uma rotina de envio de um relatório em PDF por e-mail utilizando o Outlook;
    Estou adaptando exemplos dos colegas colaboradores com maior experiencia;

    O problema que ocorre é o seguinte:

    Tenho 3 contas no Outlook (por exemplo: email1@dominio.com / leitefazenda.boleto1@gmail.com / email3@dominio.com)

    Ajusto o codigo em VBA para enviar usando a conta "leitefazenda.boleto1@gmail.com".

    Se estou com o Outlook "aberto" funciona corretamente, as mensagens vão para a caixa de saída da conta escolhida;

    Se estou com o Outlook "fechado" as mensagens vão, parte para "leitefazenda.boleto1@gmail.com" e parte para "email1@dominio.com";

    Não identifiquei o porque;

    Segue parte do codigo:.

    Variáveis iniciais envolvidas na rotina:

    Dim objOut As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim objContas As Outlook.Accounts
    Dim objAnexo As Outlook.Attachments

    ... aqui tem as funções do recordset

    Aqui inicia o envio do e-mail:

    Set objOut = New Outlook.Application
    Set objMail = objOut.CreateItem(olMailItem)
    Set objAnexo = objMail.Attachments

    With objMail

       If Len(rs("CLI_EML") & "") > 0 Then ' se existir e-mail 1
           .To = rs("CLI_EML") 'destinatário
       End If
       
       If Len(rs("CLI_EML2") & "") > 0 Then ' se existir e-mail 2
           .CC = rs("CLI_EML2") 'com cópia
       End If
       
    '   .BCC = Nz(Me!TxCco, "") 'Com cópia oculta
       .Subject = "Consumo e Boleto - " & Me.PERI 'assunto
       
       'adiciona o arquivo pdf no anexo
        objAnexo.Add StrLocal, olByValue, 1
       
       'conta de envio - Outlook
       .SendUsingAccount = objOut.Session.Accounts(Me.CTEE.Value)   'conta que enviará o email
       'pausa o envio (X segundos)
       Pausa (Me.TMOU)
       .send 'envia o email

    O campo em destaque "ME.CTEE" é onde está informada a conta que deveria ser usada para todos os envios;

    Segue junto da duvida o formulário de captura dos dados;



    Grato;

    Carniel
    Anexos
    Envio de e-mail pelo Outlook não respeita conta selecionada no codigo VBA AttachmentTELA.png
    Você não tem permissão para fazer download dos arquivos anexados.
    (28 Kb) Baixado 2 vez(es)
    DamascenoJr.
    DamascenoJr.
    Moderador
    Moderador

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2137
    Registrado : 22/11/2016

    Envio de e-mail pelo Outlook não respeita conta selecionada no codigo VBA Empty Re: Envio de e-mail pelo Outlook não respeita conta selecionada no codigo VBA

    Mensagem  DamascenoJr. em 29/4/2020, 02:26

    Neste link
    usandoaccess.com.br/blog/responder-email-conta-especifica-outlook.asp

    parece que resolveram usando a propriedade SentOnBehalfOfName


    .................................................................................
    Ajude-se a ser ajudado, anexe seu projeto.
    Sempre tente entender o código,
    não somente copie e cole.
    Positive as mensagens que achar útil clicando no '+' no canto superior direito delas.
    avatar
    carniel.ass.info
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 49
    Registrado : 14/09/2012

    Envio de e-mail pelo Outlook não respeita conta selecionada no codigo VBA Empty Re: Envio de e-mail pelo Outlook não respeita conta selecionada no codigo VBA

    Mensagem  carniel.ass.info em 29/4/2020, 20:19

    Caro Damasceno agradeço sua boa intenção na ajuda, porem não funcionou com esse comando;
    A rotina de envio pelo VBA "ignora" a linha onde usamos o "SentOnBehalfOfName";
    A "unica" forma de as mensagens serem abrigadas na caixa de saída desejada é mantendo o Outlook "aberto";
    Dessa forma "todas" as mensagens geradas vão para a caixa de saída desejada;

    Estou trabalhando com 3 (três) registros inicialmente para teste com os seguintes resultados:

    1 - Enviando com o Outlook Fechado usando no código a conta "não" padrão (a mensagens ficam divididas 1 msg na caixa de saída (desejada), e 2 caixas de saída (padrão))

    2 - Enviando com o Outlook Aberto usando no código a conta "não" padrão (as mensagens ficam somente na caixa de saída desejada)

    Por fim segue o código inteiro caso queira dar uma espiada;

    Como meu cliente enviará os e-mails e anexos ainda nesse inicio de mês, manterei a rotina do jeito que está funcionando, mas quero aprimora-la;

    Segue código na integra, lembrando que os campos Me. ou Me! são alimentados no pelo recordset, Form e código (já enviado na 1ª postagem):

    Sub PDFEMAIL()

    'Exibe controles barra de progresso
    Me.Cx0.visible = True
    Me.cx1.visible = True
    Me.cx2.visible = True
    Me.txtPorcentagem.visible = True
    Me.txt1.visible = True

    Dim objOut As Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim objContas As Outlook.Accounts
    Dim objAnexo As Outlook.Attachments
    Dim StrArquivo, StrLocal, StrLdis, StrFiltro As String

    'variaveis barra de progresso
    Dim P As Long
    Dim ESCALA As Variant

    'Consulta pronta com o consumo ou o consumo e boleto
    Dim DB As DAO.Database
    Dim rs As DAO.Recordset

    'Referenciando recordsets
    Set DB = CurrentDb
    Set rs = DB.OpenRecordset("CstBaseRelCsAgrp")

    Me!txt1 = "Processando o envio dos e-mails..."

    rs.MoveLast: rs.MoveFirst ' para obter a qnt de registro de forma correta
    ESCALA = (8 * 567) / rs.RecordCount 'Divido o Tamanho Máximo da Escala pela Qnt de registro, para saber quanto ela deve crescer a cada Registro

    Do While Not rs.EOF
    P = P + 1 'Para saber qual ocorrencia esta sendo exportada
    Me!txt1 = "Enviando e-mail: " & Format(P, "00") & " de " & Format(rs.RecordCount, "00")
    Me!txt1.Requery

    StrArquivo = TiraPeT(rs("CLI_LDIS")) & ".pdf" 'cliente atual em loop
    StrLocal = CurrentProject.Path & "\PDFs\" & StrArquivo

    'Abre o relatório filtrado e oculto de acordo com o cliente em loop.

    StrLdis = rs("CLI_LDIS")
    StrFiltro = "[CLI_LDIS]=" & "'" & StrLdis & "'"

    DoCmd.OpenReport "Rlt_FichaConsumo_FichCs", acViewPreview, , StrFiltro, acWindowNormal

    'Gera o pdf do relatório
    DoCmd.OutputTo acOutputReport, "Rlt_FichaConsumo_FichCs", acFormatPDF, StrLocal

    'Fecha o relatório que está oculto
    DoCmd.Close acReport, "Rlt_FichaConsumo_FichCs"

    'Variaveis do Outlook
    Set objOut = New Outlook.Application
    Set objMail = objOut.CreateItem(olMailItem)
    Set objAnexo = objMail.Attachments

    With objMail
       
       If Len(rs("CLI_EML") & "") > 0 Then ' se existir e-mail 1
           .To = rs("CLI_EML") 'destinatário
       End If
       
       If Len(rs("CLI_EML2") & "") > 0 Then ' se existir e-mail 2
           .CC = rs("CLI_EML2") 'com cópia
       End If
       
    '   .BCC = Nz(Me!TxCco, "") 'Com cópia oculta

       .Subject = "Consumo e Boleto - " & Me.PERI 'assunto
       
       'adiciona o arquivo pdf no anexo
        objAnexo.Add StrLocal, olByValue, 1
       
       'conta de envio - Outlook
       'pausa o envio (x segundos)
       Pausa (Me.TMOU)
       .SendUsingAccount = objOut.Session.Accounts(Me.CTEE.Value)     'conta que enviará o email
       .send  'envia o email

    'Ajuste da Barra progresso
    Me!cx2.Width = ESCALA * P
    Me!txtPorcentagem = Format((Me!cx2.Width * 100) / 4536, "0.00") & "%"

    End With

    rs.MoveNext
    Loop

    FechaRs:
    rs.Close
    DB.Close

    Set objMail = Nothing
    Set objOut = Nothing
    Set objAnexo = Nothing

    MsgBox "Emails enviados com Sucesso !", vbInformation, "Sucesso!!!"

    'oculta controles barra de progresso
    Me.Cx0.visible = False
    Me.cx1.visible = False
    Me.cx2.visible = False
    Me.txtPorcentagem.visible = False
    Me.txt1.visible = False

    Me!cx2.Width = Empty
    Me!txtPorcentagem = Empty

    Me.LDIS = Empty
    Me.LDIS.SetFocus
    Me.SetFocus

    End Sub

      Data/hora atual: 10/8/2020, 05:33