Erro 70 - Backup

Visual Basic for Aplication e macros no Excel.
Regras do fórum
Sua dúvida foi respondida? Marque como RESOLVIDO em seus tópicos, usando o botão com marca verde. Imagem

Erro 70 - Backup

Mensagempor romanholi » Sex Nov 09, 2018 11:15 am

Pessoal, estou utilizando o código abaixo para fazer backup de alguns arquivos.
O problema é que alguns arquivos no momento do backup estarão abertos e o código não deixa copiar. Erro 70
Como eu faço para desprezar esse erro e copiar o arquivo mesmo que ele esteja aberto. Adaptar o código abaixo:

Código: Selecionar todos
Sub GerarBackup()


On Error Resume Next
'On Error GoTo Erro_GerarBackup
     
     Dim Mensagem As String
     Dim NomeArquivo As String, DiretorioOrigem As String, DiretorioDestino As String
     Dim UltimaLinha As Long
     
     UltimaLinha = ActiveSheet.Cells(1, 1).End(xlDown).Row
     
     'Executa o processo para cada um dos arquivos existentes
     For i = 2 To UltimaLinha
         
          If Range("D" & i).Value <> "OK" Then
            'Carrega as informações do arquivo a ser copiado
            NomeArquivo = Cells(i, 1).Text
            DiretorioOrigem = Cells(i, 2).Text & "\"
            DiretorioDestino = Cells(i, 3).Text & "\"
           
            FileCopy DiretorioOrigem & NomeArquivo, DiretorioDestino & NomeArquivo
           
            'Tratamento de erros para verificar se a cópia do arquivo foi executada com sucesso
           

            Select Case Err.Number
           
                 Case 0:   'OK
                           Cells(i, 4).Value = "OK"
                           Cells(i, 5).Value = Now
                           
                 Case 53:  'Arquivo não encontrado
                           Cells(i, 4).Value = "ERRO (ARQ. NAO ENCONTRADO)"
                           
                 Case 70:  'Arquivo aberto
                           Cells(i, 4).Value = "ERRO (ARQUIVO ABERTO)"
                           
                 Case 75:  'Acesso não permitido no diretório de destino
                           Cells(i, 4).Value = "ERRO (ACESSO NEGADO)"
                           
                 Case 76:  'Diretório não encontrado
                           Cells(i, 4).Value = "ERRO (PASTA NAO ENCONTRADA)"
                           
                 Case Else:
                           Mensagem = "Arquivo: " & NomeArquivo & vbCrLf & _
                                     "Pasta Origem: " & DiretorioOrigem & vbCrLf & _
                                     "Pasta Destino: " & DiretorioDestino & vbCrLf & _
                                     "Erro: " & Err.Number & " " & Err.Description
                           MsgBox Mensagem, vbExclamation
                           Cells(i, 4).Value = "ERRO"
           
            End Select
           
            'Zera a variável antes de iniciar a cópia do próximo arquivo
            Err.Number = 0
        End If
               
     Next i
     
     
Fim:
     Exit Sub


Erro_GerarBackup:
     
     Mensagem = Err.Number & " " & Err.Description
     MsgBox Mensagem
romanholi
Membro
Membro
 
Mensagens: 180
Registrado em: Seg Abr 18, 2016 9:09 am
Has thanked: 59 times
Have thanks: 5 times

{ SO_SELECT }

Voltar para VBA & Macros

Quem está online

Usuários navegando neste fórum: Google Adsense [Bot] e 5 visitantes