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

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

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

parece que resolveram usando a propriedade SentOnBehalfOfName

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