Página 1 de 1

RESOLVIDO : Backup automático somente dos arquivos Visíveis

Enviado: Ter Ago 08, 2017 11:07 am
por Mathmatic
Saudações,

encontrei uma planilha (muito útil para mim) que faz Backup automático de arquivos, cuja mesma está no seguinte Link:

https://guiadoexcel.com.br/backup-autom ... excel-vba/


descrição da minha necessidade:

coloquei nesta planilha do Link uma Lista de muitos arquivos. Então Filtrarei todo dia na coluna A os arquivos que desejo fazer o Backup, e depois apertarei no botão para fazer o Backup somente dos arquivos que estão Visíveis na coluna A.

é aí que está minha necessidade, preciso acrescentar no cód. VBA já existente o comando .SpecialCells(xlCellTypeVisible) para que execute somente na células Visíveis da coluna A.

já tentei de várias formas, mas não consegui fazer funcionar ao acrescentar o comando .SpecialCells(xlCellTypeVisible)


Resumindo:

só quero fazer Backup de alguns arquivos que estão Listados na coluna A, mas como não sei antecipado qual será os arquivos, então coloquei todos possíveis na Lista da coluna A, para depois Filtrar e então apertar no botão no Backup.

por isso senhores venho pedir vossa ajuda para acrescentar o comando .SpecialCells(xlCellTypeVisible) no cód. vba da planilha, para que faça o Backup somente dos arquivos que Filtrei na coluna A (Backup somente dos escolhidos no filtro).



desde já agradeço aos senhores pela ajuda.

Re: Backup automático somente dos arquivos Visíveis

Enviado: Ter Ago 08, 2017 12:46 pm
por srobles
Mathmatic,

Já experimentou utilizar ActiveCell.EntireRow.Hidden = False ao invés do .SpecialCells(xlCellTypeVisible) ?

Nos teste que realizei aqui funcionou, então disponibilizo a rotina alterada abaixo.

Código: Selecionar todos

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
     	'Selecionamos a linha de índice i na coluna A
        Cells(i, "A").Select
        'Verificamos se a mesma está oculta
          If ActiveCell.EntireRow.Hidden = False Then
              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
          End If
     Next i
     
     
Fim:
     Exit Sub


Erro_GerarBackup:
     
     Mensagem = Err.Number & " " & Err.Description
     MsgBox Mensagem
     
End Sub
Apenas troque a existente na planilha por esta.

Abs

Re: RESOLVIDO: Backup automático somente dos arquivos Visíveis

Enviado: Ter Ago 08, 2017 2:10 pm
por Mathmatic
Tópico RESOLVIDO !

sr. srobles, funcionou perfeitamente, muito obrigado pela ajuda.

Obs: coloquei a palavra RESOLVIDO aqui na resposta, pois não sei como colocar no título inicial para aparecer para todos.


abs.

Re: Backup automático somente dos arquivos Visíveis

Enviado: Ter Ago 08, 2017 2:30 pm
por srobles
Mathmatic,

Que boa notícia amigo!

Para editar o título de seu tópico, clique na caneta ao lado do primeiro post e o campo Título aparecerá para ser editado.

Abs