Saudações,
a planilha do Link: https://guiadoexcel.com.br/backup-autom ... excel-vba/ faz um Backup automático de arquivos apresentando a Data e Horário que foi executado o Backup (Término) de cada arquivo.
minha necessidade:
preciso acrescentar neste cód. vba da planilha do Link mais um "comando vba" que me apresente (numa nova coluna) a Data e Horário do Salvamento do arquivo na Pasta (diretório).
hoje só consigo ver esta informação se eu abrir a pasta (diretório) onde está o arquivo e então olhar lá a Data e Horário que foi salvo o mesmo.
Resumindo:
acrescentar cód. vba que mostre também para cada arquivo do Backup, a Data e Horário do Salvamento do mesmo na Pasta (diretório).
desde já agradeço pela vossa ajuda.
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
[RESOLVIDO] Data e Horário de Salvamento no Diretório
[RESOLVIDO] Data e Horário de Salvamento no Diretório
Editado pela última vez por Mathmatic em Dom Ago 13, 2017 1:54 am, em um total de 1 vez.
Re: Data e Horário de Salvamento no Diretório
Mathmatic,
Não sei se está utilizando o código do modelo do site na íntegra, mas vamos lá.
No código existente no site :
Experimente adicionar o que segue abaixo, após a linha Cells(i,5) = Now :
Altere as colunas á serem preenchidas conforme sua necessidade.
Abs
Não sei se está utilizando o código do modelo do site na íntegra, mas vamos lá.
No código existente no site :
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
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
Código: Selecionar todos
Cells(i,6) = Format(Now, "DD/MM/YYYY") 'Para gravar a data
Cells(i,7) = Format(Now, "hh:mm:ss") 'Para gravar a hora
Abs
Re: [RESOLVIDO] Data e Horário de Salvamento no Diretório
tópico RESOLVIDO.
Saudações sr. srobles ,
sua idéia foi muito boa.
eu também já havia tido uma idéia parecida com esta sua e apliquei-a.
muito obrigado por sua colaboração e atenção.
abs.
Saudações sr. srobles ,
sua idéia foi muito boa.
eu também já havia tido uma idéia parecida com esta sua e apliquei-a.
muito obrigado por sua colaboração e atenção.
abs.