Preciso de uma ajuda. O código abaixo envia um email anexando arquivos que constam numa pasta, porém, nem sempre esses arquivos estão na pasta. Para remediar esse problema eu tentei utilizar o On Error goto, mas infelizmente ele para o código... o primeiro até passa mas ele esta parando na linha abaixo:
Código: Selecionar todos
On Error GoTo Pula04:
.Item.Attachments.Add Pasta & "\Gerados\" & VBA.Format(VBA.Date, "YYYY-MM") & "- " & Sheets("APOIO").Range("B3") & " - SUPER BRILHO - Indicadores da Qualidade" & ".pdf"
Pula04:
Existe alguma outra forma de simplificar o código abaixo, ou resolver esse problema?
Muito Obrigado
Código: Selecionar todos
Sub DEF_ENV_EMAIL()
Application.ScreenUpdating = False
Dim Arquivo As String
Dim Pasta As String
Dim Email As String
Dim Corpo As String
Pasta = ThisWorkbook.Path
Email = Sheets("APOIO").Range("A3")
Corpo = Sheets("APOIO").Range("A14")
Sheets(Array("GRA_QUA", "GRA_PRO", "GRA_DEF")).Select
Arquivo = Pasta & "\Gerados\" & VBA.Format(VBA.Date, "YYYY-MM") & "- " & Sheets("APOIO").Range("B3") & " - Indicadores da Qualidade" & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Arquivo _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Application.ScreenUpdating = False
Sheets("EMAIL").Select
' Seleciona o intervalo de células a serem enviadas por email.
ActiveSheet.Range("B2:N18").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
'.Introduction = "Prezados(as)." & vbCr & "Abaixo Relação dos lançamentos realizados no sistema sem cadasto de motivo" ' Texto Corpo do e-mail
.Item.To = Email
'.Item.Cc = ""
.Item.Subject = VBA.Format(VBA.Date, "YY-MM-DD") & " - " & Sheets("APOIO").Range("B3") & " - Indicadores da Qualidade"
.Item.Attachments.Add Arquivo
On Error GoTo Pula01:
.Item.Attachments.Add Pasta & "\Gerados\" & VBA.Format(VBA.Date, "YYYY-MM") & "- " & Sheets("APOIO").Range("B3") & " - LACCA - Indicadores da Qualidade" & ".pdf"
Pula01:
On Error GoTo Pula02:
.Item.Attachments.Add Pasta & "\Gerados\" & VBA.Format(VBA.Date, "YYYY-MM") & "- " & Sheets("APOIO").Range("B3") & " - SEMI FOSCO - Indicadores da Qualidade" & ".pdf"
Pula02:
On Error GoTo Pula03:
.Item.Attachments.Add Pasta & "\Gerados\" & VBA.Format(VBA.Date, "YYYY-MM") & "- " & Sheets("APOIO").Range("B3") & " - STUDIO - Indicadores da Qualidade" & ".pdf"
Pula03:
On Error GoTo Pula04:
.Item.Attachments.Add Pasta & "\Gerados\" & VBA.Format(VBA.Date, "YYYY-MM") & "- " & Sheets("APOIO").Range("B3") & " - SUPER BRILHO - Indicadores da Qualidade" & ".pdf"
Pula04:
On Error GoTo Pula05:
.Item.Attachments.Add Pasta & "\Gerados\" & VBA.Format(VBA.Date, "YYYY-MM") & "- " & Sheets("APOIO").Range("B3") & " - CALIBRADO - Indicadores da Qualidade" & ".pdf"
Pula05:
On Error GoTo Pula06:
.Item.Attachments.Add Pasta & "\Gerados\" & VBA.Format(VBA.Date, "YYYY-MM") & "- " & Sheets("APOIO").Range("B3") & " - VITRIO - Indicadores da Qualidade" & ".pdf"
Pula06:
.Item.Send
End With
MsgBox "Barberan Enviado com Sucesso"
Sheets("MENU").Select
Application.ScreenUpdating = True
End Sub