Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Backup pliku zależny od załadowania nowego?

Auditorius · Exceloholic Wersja: Win Office 2013 Posty: 185

Mam folder do którego mam robić upload pliku (konsolidacja danych z różnych źródeł).
Plik niestety musi się nazywac tak samo każdego dnia itp. np. Dane klientow.xls

Ja chciałbym dla bezpieczeństwa i ew. identyfikacji źródeł błędnych danych zapisywać ten plik oprócz lokalizacji "głównej" także w lokalizacji zapasowej (backup)

Chodzi jednak o to by to zapisywanie zapasowe nie było uzależnione od człowieka (typu uruchom makro, skopiuj plik, zamknij makro) jak poniżej

Kod:

Sub Backup()
'Step 1: Create a Backup of a Workbook with Current Date in the Same folder
ThisWorkbook.SaveCopyAs _
FileName:=ThisWorkbook.Path & "\" & _
Format(Date, "mm-dd-yy") & " " & _
ThisWorkbook.Name
End Sub

Kod:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sFileName As String
Dim sDateTime As String

With ThisWorkbook
sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
sFileName = Application.WorksheetFunction.Substitute _
(.FullName, ".xlsm", sDateTime)
.SaveCopyAs sFilename
End With
End Sub

W zamian - chodzi o "wykrycie" faktu że został wgrany nowy plik.
Jak sobie to wyobrażam ?
Wariant 1
Wgrałem plik x.xls. Wygenerowałem dla niego SHA (to potrafię) i to SHA lub inny hash sobie przechowuję. Jak wgrany jest nowy plik(z tą samą nazwą) ale z nowym SHA ==> GENERUJE SIĘ NOWE SHA , porównuje do istniejącego i bingo ==> mamy nowy plik, zrób jego kopię

Wariant 2
"Stary plik" ma datę utworzenia => którą też gdzieś zapisuję jako zmienną
Jezeli wgrany jest nowy plik, to ma nową, inną datę utworzenia. Porównuję 2 daty => bingo zrób kopię.

Nie wiem natomiast jak napisać procedurę automatycznego sprawdzania np. 3 razy dziennie (załóżmy 6 rano, 13 i 17 czy jest nowy plik w danym katalogu)

Katalog jest stały, nazwa pliku też...

Marecki · Wysłany: 20-02-2021, 22:25

Zrób sobie plik Excela z kodem w Workbook_Open porównującym np MD5Hex i umieść go (odwołanie) w harmonogramie Windowsa.

Nawet nie musi to być Excel, może to być plik tekstowy - wykonywalny VBS.

Auditorius · Exceloholic Wersja: Win Office 2013 Posty: 185

@Marecki,

Na 99% na pewno masz rację tylko ja nie wiem jak obsłużyć harmonogram Windowsa... Nawet mówiąc szczerze nie wiem co to za stwór...(ten harmonogram)

Artik · Wersja: Win Office 365 **Pomógł:** 3091 razy Posty: 10240

Najpierw oswój się z Harmonogramem zadań. Potem pomyślisz co dalej. :-)

Artik

Harmonogram zadań.png

Plik ściągnięto 9 raz(y) 38.46 KB

Marecki

Taki kod dla pliku wykonywalnego vbs

Kod:

Const Folder_Arch = "D:\Archiwum\"
Const Folder_xlsx = "D:\"
Const Folder_txt = "D:\"
Const Plik_xlsx = "test.xlsx"
Const Plik_txt = "test.txt"
Dim FSO
Dim oMD5
Dim Md5_txt
Dim Md5_xls
Dim Kopia_xlsx
Dim Plik

Kopia_xlsx = timeStamp & Plik_xlsx
Plik = Folder_xlsx & Plik_xlsx

Set oMD5 = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
Md5_xls = GetMd5(Folder_xlsx & Plik_xlsx)
Md5_txt = IO_file(Folder_txt & Plik_txt, "", False)

If Md5_txt <> Md5_xls Then
Call IO_file(Folder_txt & Plik_txt, Md5_xls, True)
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile Folder_xlsx & Plik_xlsx, Folder_Arch
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.MoveFile Folder_Arch & Plik_xlsx, Folder_Arch & Kopia_xlsx
End If

Function GetMd5(Plik)
Dim oXml, oElement
oMD5.ComputeHash_2 (GetBinaryFile(Folder_xlsx & Plik_xlsx))
Set oXml = CreateObject("MSXML2.DOMDocument")
Set oElement = oXml.CreateElement("tmp")
oElement.DataType = "bin.hex"
oElement.NodeTypedValue = oMD5.Hash
GetMd5 = oElement.Text
End Function

Function GetBinaryFile(Plik)
Dim oStream: Set oStream = CreateObject("ADODB.Stream")
oStream.Type = 1 'adTypeBinary
oStream.Open
oStream.LoadFromFile Folder_xlsx & Plik_xlsx
GetBinaryFile = oStream.Read
oStream.Close
Set oStream = Nothing
End Function

Function IO_file(sfile, sStr, save)
Const ForReading = 1, ForWriting = 2
Dim FSO, f
Set FSO = CreateObject("Scripting.FileSystemObject")
If save Then
Set f = FSO.OpenTextFile(sfile, ForWriting, True)
f.Write sStr
Else
Set f = FSO.OpenTextFile(sfile, ForReading)
IO_file = f.ReadLine
End If
End Function

Function timeStamp()
Dim t
t = Now
timeStamp = Year(t) & "-" & _
Right("0" & Month(t), 2) & "-" & _
Right("0" & Day(t), 2) & " " & _
Right("0" & Hour(t), 2) & "_" & _
Right("0" & Minute(t), 2) & " "
End Function

Skopiuj plik do notatnika.
Dopasuj dane do swoich , czyli edytuj stałe

Kod:

Const Folder_xlsx = "D:\"
Const Folder_txt = "D:\"
Const Plik_xlsx = "test.xlsx"
Const Plik_txt = "test.txt"

zapisz plik z rozszerzeniem vbs i umieść w harmonogramie.