Planilha-de-escala-de-trabalho-Excel
Planilha de escala de trabalho Excel
28 de maio de 2015
Remover espaços em branco Excel Internet
Remover espaços em branco de cópias de dados da internet Excel
17 de junho de 2015

Objetivo: Disponibilizar um arquivo Excel que realiza o backup automático de arquivos com Excel VBA.

Backup Excel VBA

Esta planilha foi criada pelo meu amigo Edney Nascimento, ao qual agradeço pela colaboração com o site.

O Edney já colaborou enviando mais dois arquivos:

Marcar vários filtros na tabela dinâmica automaticamente – VBA

Excel converter taxa de juros em períodos – Ano para mês, mês para dia…

Caso o leitor queira auxiliar com o crescimento da base de conhecimento da internet em Excel, além de divulgar seus trabalhos, é só enviar um comentário em qualquer página do Guia do Excel, eu leio e respondo todos os comentários que são sempre bem-vindos.

Neste artigo vamos disponibilizar uma planilha Excel que realiza o backup de arquivos, não necessariamente de Excel, copiando de uma pasta para outra.

A interface é a seguinte:

Backup Excel VBA 2

ARQUIVO: Digite aqui o nome do arquivo, inclusive a extensão do mesmo;

DIRETÓRIO DE ORIGEM: Inscreva aqui o diretório aonde o arquivo está armazenado;

DIRETÓRIO DE DESTINO: Digite a pasta aonde será salvo o arquivo, o nome do arquivo salvo será o mesmo;

STATUS: Este campo é preenchido quando o arquivo é copiado ou quando há um erro na cópia do mesmo, este tratamento de erros está em português, facilitando a correção;

TÉRMINO: Data e hora do término da cópia do arquivo, pois irá depender do tamanho do mesmo.

Ao lado da tabela estão dois botões:

GERAR BACKUP: Efetua a cópia dos arquivos que estejam com a descrição do status diferente de OK, ou seja, se houver um erro na primeira tentativa ou estiver em branco a descrição do campo status, os arquivos serão copiados;

LIMPAR: Realiza a limpeza das colunas Status e Término, para que possa ser realizado um novo backup completo dos arquivos.

Abaixo o código VBA que realiza a cópia dos arquivos e a limpeza dos mesmos, e logo abaixo o botão para o download do arquivo Excel.

Sub GerarBackup()
'Macro gravada em 11/06/2015 por Edney Nascimento

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
     
End Sub

Sub lsLimpar()
    Dim lUltimaLinhaAtiva As Long
    
    lUltimaLinhaAtiva = Worksheets("Backup").Cells(Worksheets("Backup").Rows.Count, 1).End(xlUp).Row
    
    Range("D2:E" & lUltimaLinhaAtiva).Clear
    
End Sub

GUT PPT

Abraço
Marcos Rieper

2 Comments

  1. Lúcio disse:

    Como gravar o backup no o nome do arquivo acrescentando data e horário do backup?

Deixe uma resposta

O seu endereço de e-mail não será publicado. Campos obrigatórios são marcados com *

Esse site utiliza o Akismet para reduzir spam. Aprenda como seus dados de comentários são processados.

Inscreva-se no nosso canal do Youtube!


Junte-se ao nosso canal do Youtube. Começamos em abril de 2016, mas já temos mais de 06:00 h de treinamentos gratuitos e este número irá aumentar. Vídeos novos todos os sábados.