Esqueceu sua senha? Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

Código Envio Email

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
salvador
Manda bem
Manda bem
Mensagens: 129
Registrado em: Qua Fev 12, 2014 8:01 am

Código Envio Email

Mensagem por salvador » Seg Ago 19, 2019 10:08 am

Pessoal, bom dia.

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:
De fato esse arquivo não está na pasta. Mas como eu coloquei o On Error, não era para ele pular? Não está pulando.

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



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Responder