TRATATIVAS DE ERROS VBA

2024 - VBA & Macros

Post Recente por JAlmeida 6 anos atrás

5 Posts

2 Usuários

0 Reactions

1,095 Visualizações

RSS

JAlmeida

(@jalmeida)

Posts: 43

Trusted Member

Topic starter

Galera, bom dia! Gostaria uma ajuda de vocês sobre Tratativa de Erros VBA
Tenho uma rotina que basicamente abre alguns arquivos copiam e colam em uma planilha oficial.
O problema é que, quando a macro busca o arquivo que e não o encontra, ela pára e dá um erro e não processa mais.
O que eu gostaria é que, sempre que não encontrasse esse arquivo a macro continuasse a buscar os demais.
Abaixo um resumo da macro que escrevi.
Agradeço a quem puder me ajudar.
Josenildo

Sub AuditoriaEstoque()

    Dim CAM, SAR, CGI As String
    
    CAM = "C:UsersIDR0019DocumentsGoogle DriveSEDE 26 05 152018Insumos (Pedidos)7. Jul"
    SAR = "Sarapui_Pedido Alm Mes 07 Sem 02.xlsx"
    CGI = "C Grande I_Pedido Alm Mes 07 Sem 02.xlsx"
        
    Workbooks.Open Filename:=CAM & SAR
    Sheets("Material").Activate
    Range("B5:H216").Select
    Selection.Copy
    Windows("Auditoria Estoque").Activate
    Sheets("REC SAR").Select
    Range("B5").PasteSpecial Paste:=xlPasteValues

    Workbooks.Open Filename:=CAM & CGI
    Sheets("Material").Activate
    Range("B5:H216").Select
    Selection.Copy
    Windows("Auditoria Estoque").Activate
    Sheets("REC CGI").Select
    Range("B5").PasteSpecial Paste:=xlPasteValues
           
End Sub

Postado : 03/07/2018 8:13 am

klarc28

(@klarc28)

Posts: 971

Prominent Member

Sub AuditoriaEstoque()

Dim CAM, SAR, CGI As String

CAM = "C:UsersIDR0019DocumentsGoogle DriveSEDE 26 05 152018Insumos (Pedidos)7. Jul"
SAR = "Sarapui_Pedido Alm Mes 07 Sem 02.xlsx"
CGI = "C Grande I_Pedido Alm Mes 07 Sem 02.xlsx"
If not Dir(CAM & SAR) = vbNullString Then
Workbooks.Open Filename:=CAM & SAR
Sheets("Material").Activate
Range("B5:H216").Select
Selection.Copy
Windows("Auditoria Estoque").Activate
Sheets("REC SAR").Select
Range("B5").PasteSpecial Paste:=xlPasteValues

Workbooks.Open Filename:=CAM & CGI
Sheets("Material").Activate
Range("B5:H216").Select
Selection.Copy
Windows("Auditoria Estoque").Activate
Sheets("REC CGI").Select
Range("B5").PasteSpecial Paste:=xlPasteValues
end if
End Sub

Postado : 03/07/2018 8:25 am

JAlmeida

(@jalmeida)

Posts: 43

Trusted Member

Topic starter

Prezado Klarc28, agradeço o retorno, entretanto informo que a rotina já possui uma condição com If (para limpeza do arquivo).
Quando você informa If not Dir(CAM & SAR) = vbNullString Then, a rotina se refere apenas ao arquivo SAR, é isso? Se for não vai adiantar porque são vários arquivos.
O que eu preciso é que, se procurar qualquer arquivo dos listados e não encontrar algum, a rotina pula para o próximo.
Pensei em algo como On Error mas não está dando certo porque ele simplesmente fecha o arquivo.
Veja abaixo a rotina toda ...

Option Explicit
Public Const Title As String = "Auditoria de Estoque"
Sub AuditoriaEstoque()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
  
    Dim CAM, SAR, CGI, CGII, SCZ As String
    
    CAM = "C:UsersIDR0019DocumentsGoogle DriveSEDE 26 05 152018Insumos (Pedidos)7. Jul"
    SAR = "Sarapui_Pedido Alm Mes 07 Sem 02.xlsx"
    CGI = "C Grande I_Pedido Alm Mes 07 Sem 02.xlsx"
    CGII = "C Grande II_Pedido Alm Mes 07 Sem 02.xlsx"
    SCZ = "Santa Cruz_Pedido Alm Mes 07 Sem 02.xlsx"
    
    If MsgBox("Gostaria de limpar os dados da Semana Anterior?", vbYesNo + vbQuestion, Title) = vbYes Then
    
    Sheets(Array("REC SAR", "REC CGI", "REC CGII", "REC SCZ")).Select
    Sheets("REC SAR").Activate
    Range("A5:H216").ClearContents
    
    Workbooks.Open Filename:=CAM & SAR
    Sheets("Material").Activate
    Range("B5:H216").Select
    Selection.Copy
    Windows("Auditoria Estoque").Activate
    Sheets("REC SAR").Select
    Range("B5").PasteSpecial Paste:=xlPasteValues
    Windows("SARAPUI_Pedido Alm Mes 07 Sem 02").Activate
    ActiveWorkbook.Close

    Workbooks.Open Filename:=CAM & CGI
    Sheets("Material").Activate
    Range("B5:H216").Select
    Selection.Copy
    Windows("Auditoria Estoque").Activate
    Sheets("REC CGI").Select
    Range("B5").PasteSpecial Paste:=xlPasteValues
    Windows("C GRANDE I_Pedido Alm Mes 07 Sem 02").Activate
    ActiveWorkbook.Close
    
    Workbooks.Open Filename:=CAM & CGII
    Sheets("Material").Activate
    Range("B5:H216").Select
    Selection.Copy
    Windows("Auditoria Estoque").Activate
    Sheets("REC CGII").Select
    Range("B5").PasteSpecial Paste:=xlPasteValues
    Windows("C GRANDE II_Pedido Alm Mes 07 Sem 02").Activate
    ActiveWorkbook.Close
    
    Workbooks.Open Filename:=CAM & SCZ
    Sheets("Material").Activate
    Range("B5:H216").Select
    Selection.Copy
    Windows("Auditoria Estoque").Activate
    Sheets("REC SCZ").Select
    Range("B5").PasteSpecial Paste:=xlPasteValues
    Windows("SANTA CRUZ_Pedido Alm Mes 07 Sem 02").Activate
    ActiveWorkbook.Close
    
    MsgBox "Limpeza e atualização efetuados com sucesso!", vbInformation, Title
    
    Else
    Exit Sub
    End If
Sheets("Sarapui").Select
Cells(2, 10).Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Postado : 03/07/2018 8:42 am

klarc28

(@klarc28)

Posts: 971

Prominent Member

Basta seguir o mesmo modelo para os outros arquivos:

Option Explicit
Public Const Title As String = "Auditoria de Estoque"
Sub AuditoriaEstoque()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim CAM, SAR, CGI, CGII, SCZ As String

CAM = "C:UsersIDR0019DocumentsGoogle DriveSEDE 26 05 152018Insumos (Pedidos)7. Jul"
SAR = "Sarapui_Pedido Alm Mes 07 Sem 02.xlsx"
CGI = "C Grande I_Pedido Alm Mes 07 Sem 02.xlsx"
CGII = "C Grande II_Pedido Alm Mes 07 Sem 02.xlsx"
SCZ = "Santa Cruz_Pedido Alm Mes 07 Sem 02.xlsx"

If MsgBox("Gostaria de limpar os dados da Semana Anterior?", vbYesNo + vbQuestion, Title) = vbYes Then

Sheets(Array("REC SAR", "REC CGI", "REC CGII", "REC SCZ")).Select
Sheets("REC SAR").Activate
Range("A5:H216").ClearContents
If not Dir(CAM & SAR) = vbNullString Then
Workbooks.Open Filename:=CAM & SAR
Sheets("Material").Activate
Range("B5:H216").Select
Selection.Copy
Windows("Auditoria Estoque").Activate
Sheets("REC SAR").Select
Range("B5").PasteSpecial Paste:=xlPasteValues
Windows("SARAPUI_Pedido Alm Mes 07 Sem 02").Activate
ActiveWorkbook.Close
end if
If not Dir(CAM & CGI) = vbNullString Then
Workbooks.Open Filename:=CAM & CGI
Sheets("Material").Activate
Range("B5:H216").Select
Selection.Copy
Windows("Auditoria Estoque").Activate
Sheets("REC CGI").Select
Range("B5").PasteSpecial Paste:=xlPasteValues
Windows("C GRANDE I_Pedido Alm Mes 07 Sem 02").Activate
ActiveWorkbook.Close
end if
If not Dir(CAM & CGII) = vbNullString Then
Workbooks.Open Filename:=CAM & CGII
Sheets("Material").Activate
Range("B5:H216").Select
Selection.Copy
Windows("Auditoria Estoque").Activate
Sheets("REC CGII").Select
Range("B5").PasteSpecial Paste:=xlPasteValues
Windows("C GRANDE II_Pedido Alm Mes 07 Sem 02").Activate
ActiveWorkbook.Close
end if
If not Dir(CAM & SCZ) = vbNullString Then
Workbooks.Open Filename:=CAM & SCZ
Sheets("Material").Activate
Range("B5:H216").Select
Selection.Copy
Windows("Auditoria Estoque").Activate
Sheets("REC SCZ").Select
Range("B5").PasteSpecial Paste:=xlPasteValues
Windows("SANTA CRUZ_Pedido Alm Mes 07 Sem 02").Activate
ActiveWorkbook.Close
end if
MsgBox "Limpeza e atualização efetuados com sucesso!", vbInformation, Title

Else
Exit Sub
End If
Sheets("Sarapui").Select
Cells(2, 10).Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Postado : 03/07/2018 9:04 am