Guru do Excel e Power BI

Olá amigos, tudo bem com vocês?

Estou precisando de auxílio em um código VBA.

Possuo uma planilha gerencial. Dentro dessa planilha há uma aba chamada "Programação", com lista de códigos de empresas. Essas empresas são planilhas alocadas em pasta "Planilhas". Cada planilha é nomeada com o "código de cadastro.xlsx".

Dentro da planilha gerencial tem uma macro que verifica a lista de empresas (aba programação, ex.: 1), procura e abre o arquivo verificado (Planilhas/1.xlsx), copia dados dessa planilha, fecha a planilha e segue para a próxima, até que a lisa termine.

Problema:
Algumas planilhas (ex.: 1.xlsx), ao serem utilizadas, acabam sendo corrompidas (pois nem todos os usuários possuem excel e utilizam libreoffice). Ao rodar a macro acima, ao chegar em um arquivo corrompido, a rotina para e não sei qual arquivo está com problema.

Exemplo de erro:
Imagem

Interrupção da rotina:
Imagem

Necessidade:
Criei nova aba, com a mesma lista de códigos de empresa, onde preciso que ocorra a seguinte rotina abaixo:
- verifica a lista de empresas (aba verificação, ex.: 1);
- procura e abra o arquivo verificado (Planilhas/1.xlsx);
- se não encontra erro ao abrir, inserir ao lado da lista das empresas (aba verificação, ex.: 1) valor = verificado e passa para o próximo item da lista;
- se encontrar erro ao abrir, inserir ao lado da lista das empresas (aba verificação, ex.: 1) valor = erro e passa para o próximo item da lista;
- Verifica até o fim da lista e, ao encerrar, saberei quais arquivos (ex.: Planilhas/1.xlsx) estão com problemas.

Assim, poderei corrigir antes de rodar a rotina de importar os dados sem que haja erro ao abrir os arquivos.

Preciso de ajuda na construção da instrução lista na Necessidade.

Encaminho o arquivos em anexo.

Desde já agradeço.

Bom dia.

Veja se o seguinte código ajuda:

Código: Selecionar todos

Public Sub Verificar()

    Dim lin01 As Integer
    Dim Arquivos, path As String
    
    Application.ScreenUpdating = False

    lin01 = 5
    
    Do Until Sheets("Programação").Cells(lin01, 2).Value = Empty
        Arquivos = Sheets("Programação").Cells(lin01, 2).Value
        
        'Indica caminho e nome do ficheiro
        path = (ThisWorkbook.path & "\Planilhas\" & Arquivos & ".xlsx")
        
        'Verifica se ficheiro existe
        
        If Dir(path) <> "" Then 'Caso exista tenta abrir
            On Error GoTo erro 'Em caso de erro vai para erro
            Workbooks.Open (ThisWorkbook.path & "\Planilhas\" & Arquivos & ".xlsx")
            Workbooks(Arquivos & ".xlsx").Close (False)
            ThisWorkbook.Sheets("Verificação").Cells(lin01, 3).Value = "Sem erro"
            lin01 = lin01 + 1

        Else 'caso não exista indica que não existe
            ThisWorkbook.Sheets("Verificação").Cells(lin01, 3).Value = "Ficheiro não existe"
            lin01 = lin01 + 1
        End If
    
volta:
    Loop
    
    Exit Sub
    
erro: 'caso de erro indica que deu erro e volta ao loop
    ThisWorkbook.Sheets("Verificação").Cells(lin01, 3).Value = "erro"
    lin01 = lin01 + 1
    GoTo volta

    Application.ScreenUpdating = True

End Sub

Alguma dúvida só dizer.

Olá Afonso.

Primeiramente agradeço pelo seu retorno sobre meu tópico. Isso mesmo que precisava.
Mas quero ver mais uma questão sobre a rotina com você.

Execução do código:
Inseri o código na planilha e aumentei a quantidade de arquivos para serem analisados (aproximadamente 450 planilhas) e, me deparei com a seguinte situação:

[*] Ao rodar ele executou mas parou no 6º registro da lista e não deu continuidade. Também não apresentou nenhum erro.
[*] A mensagem "Ficheiro não existe" aparece no arquivo 4, mas a planilha referente (4.xlsx) existe, logo, deveria aparecer "Sem erro" ou "Erro"

Ilustro abaixo com a imagem do que foi executado.

Estou analisando o código e o mesmo parece correto. Pode verificar o por que não ocorrem as situações listadas acima?

Imagem

Desde já agradeço.

Boas estive a rever o código e fiz algumas alterações.

Experimente assim, pelo menos aqui não está a dar nenhum erro.

Código: Selecionar todos

Public Sub Verificar()

    Dim i As Integer
    Dim Arquivos, path As String
   
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
   
   ultima_linha = Range("B10000").End(xlUp).Row
   
   'verifica até a ultima_linha com valor da coluna B
    For i = 5 To ultima_linha
        
        Arquivos = Sheets("Programação").Cells(i, 2).Value
        
        If Arquivos = "" Then
        
        GoTo volta
        
        End If
       
        'Indica caminho e nome do ficheiro
        path = (ThisWorkbook.path & "\Planilhas\" & Arquivos & ".xlsx")
       
        'Verifica se ficheiro existe
       
        If Dir(path) <> "" Then 'Caso exista tenta abrir
            On Error GoTo erro 'Em caso de erro vai para erro
            Workbooks.Open (ThisWorkbook.path & "\Planilhas\" & Arquivos & ".xlsx")
            Workbooks(Arquivos & ".xlsx").Close (False)
            ThisWorkbook.Sheets("Verificação").Cells(i, 3).Value = "Sem erro"
            

        Else 'caso não exista indica que não existe
            ThisWorkbook.Sheets("Verificação").Cells(i, 3).Value = "Ficheiro não existe"
            
        End If
volta:
    Next i
   
    Exit Sub
   
erro: 'caso de erro indica que deu erro e volta ao loop
    ThisWorkbook.Sheets("Verificação").Cells(i, 3).Value = "erro"
    GoTo volta
    
      
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Guru do Excel e Power BI

Tratamento de erros

Tratamento de erros

Re: Tratamento de erros

Tratamento de erros

Re: Tratamento de erros