Olá! Desenvolvi um relatório a ser enviado para investidores e automatizei o envio, conforme código abaixo. A questão é que ao executar a macro, o arquivo é gerado e salvo corretamente, aí tento gerar o arquivo novamente e ocorre um erro, que foi tratado. Mas aí, tento gerar o arquivo uma terceira vez e o arquivo é gerado. Algumas vezes tentei gerar o arquivo e ocorreu o conflito, aí apaguei o arquivo da pasta e tentei gerar novamente e o erro permaneceu, mesmo não tendo um arquivo com o mesmo nome na pasta de destino.
Cheguei a conclusão que é uma questão de tempo do refresh do windows. Até coloquei uma macro para executar o refresh antes de gerar e salvar o arquivo e funcionou, mas gerou um outro conflito. Gostaria de ajuda para ajustar a macro de forma que ao encontrar um arquivo na pasta de destino com o mesmo nome, fosse exibida uma mensagem informando sobre o arquivo e pedindo para remover da pasta. E se não encontrar um arquivo com o mesmo nome, o arquivo PDF fosse gerado e depois fosse exibida uma mensagem informando que foi gerado com sucesso.
Seguem abaixo todos os códigos:
CRIA O PDF
Sub Gerar_PDF_Simples()
On Error GoTo msgerro
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim endereco As String
endereco = Planilha14.Range("T2").Text
Sheets(Array("1 - CAPA", "2 - Resumo Executivo", "3 - Resumo de Obras", "4 - Resumo de Vendas")).Select
Sheets("1 - CAPA").Activate
' Call subRefreshDesktop
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=endereco, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
MsgBox "Arquivo gerado com sucesso! Verifique na pasta definida."
Sheets("NAVEGAÇÃO").Select
Range("A1").Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub
msgerro:
MsgBox "já existe um arquivo com o mesmo nome na pasta. Caso queira salvar um novo arquivo, remova o antigo da pasta."
Sheets("NAVEGAÇÃO").Select
Range("A1").Select
Application.ScreenUpdating = True
Exit Sub
End Sub
EXECUTA O REFRESH DO WINDOWS
Public Sub subRefreshDesktop()
Dim WSHShell As Object
Set WSHShell = CreateObject("WScript.Shell")
WSHShell.AppActivate "Program Manager"
WSHShell.SendKeys "{F5}"
Set WSHShell = Nothing
End Sub
CRIA E ENVIA O E-MAIL
Sub enviar_email()
Set appoutk = CreateObject("Outlook.Application")
Set mailoutk = appoutk.CreateItem(olmailitem)
Dim anexo As String
Dim texto As String
anexo = Planilha14.Range("T2").Value & ".pdf"
texto = Planilha20.Range("B22").Value & Chr(10) & Chr(10) & Planilha20.Range("B23") & Chr(10) & Chr(10)
With mailoutk
.display
.To = Planilha14.Range("R2").Value
.CC = ""
.BCC = ""
.Subject = Planilha14.Range("R3").Value
.body = texto & mailoutk.body 'Assinatura 'bodyhtml 'Format(mailoutk.body, "html")
.Attachments.Add (anexo)
.Importance = olImportanceHigh
'.Send
End With
Set mailoutk = Nothing
Set appoutk = Nothing
End Sub
