Envio de relatórios gerados em PDF usando "motor" do MS - Office - Outlook 365

Prezados boa tarde.

Estou em uma situação complicada com o assunto acima, vou tentar resumir a dificuldade da forma mais clara possível;

- Tenho um cliente que vende produtos de laticínio com entrega porta a porta para uma carteira de clientes dele.
- Durante o mes é feita a entrega dos produtos solicitados a no final do mes o consumo é lançado por cliente em um sistema.
- Ao concluir os lançamentos, meu cliente "roda" um relatório de consumo, aonde vão as informações pertinentes, bem como um boleto para o pagamento.
- Esse relatório faz o seguinte:

1 - monta a tabela de clientes que tiveram consumo com os produtos consumidos em dias específicos do mes
2 - exporta para uma pasta chamada "PDFs" o relatório em formato PDF (cli1.pdf / cli2.pdf etc...)
3 - Na sequencia envia ao e-mail do cliente esse relatório em anexo

Em média são 150 a 160 registros por "linha" (são 4 a 5 linhas), que são executadas uma a uma: linha1 / linha2 etc...

Até algum tempo atras funcionava perfeito, levava algo em torno de 5 a 7 minutos para concluir cada linha.
De repente de uma hora pra outra começou a ficar lento, muito lento (passando a levar 2 a 3 horas o envio ao Outlook)
Para deixar o processo o mais simples possível, meu cliente "abre" o outlook 365 e coloca o status como "offline".
Com isso os e-mails (em torno de 150) vão inicialmente para a caixa de saída, e quando o envio do Access conclui, o cliente dispara o envio pelo Outlook.

O cliente utiliza uma conta paga de e-mail "@uol", sendo esse detalhe sem importância, pois o gargalo está entre Access e Outlook (ambos 365 original)

Outro feita, pedindo a ajuda de um amigo desenvolvedor, o mesmo me orientou usar o comando (do.events) ao final de cada operação mais pesada no VBA, segundo ele para liberar memoria.

No dia dessa dica apliquei a mesma e para minha alegria deu certo, o tempo de envio reduziu para 6 a 7 minutos novamente.

Isso foi a uns 15 dias passados, hoje 03/10/24 o problema voltou causando grande prejuízo na rotina de trabalho do meu cliente, e o interessante é que, eu "puxei" a base de dados dele, o front atual em uso lá no ambiente dele, e no meu ambiente apresentou o mesmo problema.

Peço encarecidamente a ajuda dos colegas, e reporto abaixo o código que uso, tem algumas linhas que são desnecessárias comentar (caixas de texto / barra de progresso etc...) só peço para os colegas olharem se tem alguma coisa errada no código.

Friso a rotina: geração de relatório em PDF / envio para e-mail usando biblioteca Microsoft Outlook 16.0 Object Library / MS Outlook 365 (em modo Offiline e aberto durante a execução do VBA

Segue código:

Sub PDFEMAIL()

'Zera barra de progresso
Call IniVarGbl

'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
Me.txt2.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, rttxt4umavez As String

rttxt4umavez = 0

'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("CstBaseRelCsAgrp2")

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

rs.MoveLast: rs.MoveFirst ' para obter a qnt de registro de forma correta

DoEvents

'Checa se achou registros
If rs.RecordCount = 0 Then
   MsgBox "Não foram encontrados dados para emissão !", vbInformation, "Aviso"
   Me.LDIS.SetFocus
   Exit Sub
End If

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, acHidden

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

DoEvents

'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

Dim StrInv, StrFicha As Integer

With objMail
   
   ' clientes sem e-mail
   If IsNull(rs("CLI_EML")) Then
       GoTo FCHW
   End If
   
   ' emails dobrados ou invalidos 1
   If EmailOk(rs("CLI_EML")) = False Then
       If rttxt4umavez = 0 Then
           Me.txt4.visible = True
           rttxt4umavez = 1
       End If
       Me.txt4 = Me.txt4 & rs("CLI_CODC") & " / "
       StrInv = StrInv + 1
       Me!txt2 = "Invalidos: " & Format(StrInv, "00")
       GoTo FCHW
   End If
       
   ' Sinaliza o cliente atual
   Me.txt3 = rs("CLI_CODC") & " - " & rs("CLI_RAZS")
   Me.txt3.Requery
   
   .To = rs("CLI_EML") 'destinatário
   
    ' emails dobrados ou invalidos 2
   If Len(rs("CLI_EML2") & "") > 0 Then ' se existir e-mail 2
       If EmailOk(rs("CLI_EML2")) = False Then
           If rttxt4umavez = 0 Then
               Me.txt4.visible = True
               rttxt4umavez = 1
           End If
           Me.txt4 = Me.txt4 & rs("CLI_CODC") & " / "
           StrInv = StrInv + 1
           Me!txt2 = "Invalidos: " & Format(StrInv, "00")
           GoTo FCHW
       End If
   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 = Me.Asst
   
   'adiciona o arquivo pdf no anexo
    objAnexo.Add StrLocal, olByValue, 1
   
   'corpo da msg
   .BodyFormat = olFormatRichText
   If Len(Me!txMensagem) > 0 Then
       .HTMLBody = Me!txMensagem
   End If
   
   '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
   DoEvents
   StrFicha = StrFicha + 1
   
'Ajuste da Barra progresso
Call AjBp

FCHW:
End With

rs.MoveNext
Loop

FechaRs:
rs.Close
DB.Close

Set rs = Nothing
Set DB = Nothing
Set objMail = Nothing
Set objOut = Nothing
Set objAnexo = Nothing

If StrFicha > 0 Then
   MsgBox "Emails enviados com Sucesso!" & vbCrLf & vbCrLf & "Tempo de processamento -> " & ElapsedTime, vbInformation, "Ok"
End If

OCT:
'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.txt2.visible = False

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

Call btnReset

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

DoEvents

End Sub

Boa noite
Dei uma vista de olhos e não vejo nenhum código desnecessário nem que seja demorado
Tente obter a cada passo do código o tempo de execução para verificar se existe algum ponto de execução que demore em demasia e averigúe o que se passa nesse passo

Bom dia Alexandre.

Agradeço o tempo dispensado, mas veja que estranho, código em ordem como você observou mas resumindo leia abaixo as variáveis:

1 - a cerca de uns 6 meses atras funcionava perfeitamente
2 - de repente começou a ficar lento, lento, lento...
3 - efetuei vários testes, ex: base de dados "menor" com menos registros, em equipamentos diferentes, (pra ter uma ideia o equipamento do cliente é um notebook I7 - 16 GB ram - SSD 500GB), com isso maquina não é
4 - mes passado como relatei, agreguei no código os tal dos do.events (após dica de um colega) testei aqui no meu ambiente / testei no do cliente e blza, parecia tudo resolvido, processou o trabalho em 6 a 7 minutos
5 - qdo o cliente foi rodar agora 1/10 a rotina valida, voltou a lentidão (entre 2 e 3 horas) uma rotina que seria de 6 a 7 minutos
6 - a impressão que tenho é de algum "gargalo" na fase "enviar o anexo + dados do e-mail (destinatário / assunto e corpo) para o Outlook (esse estando aberto em modo "offline")
7 - nos primeiros registros, tipo até uns 20 o tempo fica dentro da normalidade, depois vai reduzindo, reduzindo e fica igual motor 1.000 aspirado na serra "rsrsrs".

Resumindo não sei o que fazer!

Vou prosseguir com os teste, inclusive pausando a execução como me recomendou e quem sabe uma luz vem.

Agradeço

Carniel

Boa tarde Carniel
A instrução DoEvents interrompe a execução do código para deixar executar outras operações que estejam na fila de espera e, só depois, continua a execução do código onde se encontra
Assim, a interrupção varia conforme o tempo necessário para executar as instruções em fila de espera no sistema e podem demorar muito tempo
Prescinda da instrução DoEvents sempre que não precise executar código em espera

Bom dia Alexandre.

Farei o ajuste indicado, estou também testando o envio dos e-mails via CDO quem sabe...

Grato