Este fórum está sendo desativado

Depois de 9 anos, este fórum será desativado. Mas calma.... estamos migrando para uma comunidade no DISCORD. Junte-se a nós.

ENTRAR PARA DISCORD

Tópicos relacionados a códigos VBA, gravação de macros, etc.
Por acva
#53818
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 "Ja 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
long long title how many chars? lets see 123 ok more? yes 60

We have created lots of YouTube videos just so you can achieve [...]

Another post test yes yes yes or no, maybe ni? :-/

The best flat phpBB theme around. Period. Fine craftmanship and [...]

Do you need a super MOD? Well here it is. chew on this

All you need is right here. Content tag, SEO, listing, Pizza and spaghetti [...]

Lasagna on me this time ok? I got plenty of cash

this should be fantastic. but what about links,images, bbcodes etc etc? [...]

Estamos migrando para uma comunidade no Discord