Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 70181 Skopiuj do schowka Backup pliku zależny od załadowania nowego?
Autor Wiadomość
Auditorius 
Exceloholic


Wersja: Win Office 2013
Posty: 185
Wysłany: 18-02-2021, 14:59   Backup pliku zależny od załadowania nowego?

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ż...
_________________
Nobody's Perfect
ID posta: 400629 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2494 razy
Posty: 8280
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.
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
  
ID posta: 400773 Skopiuj do schowka
 
 
Auditorius 
Exceloholic


Wersja: Win Office 2013
Posty: 185
Wysłany: 22-02-2021, 11:48   

@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)
_________________
Nobody's Perfect
ID posta: 400830 Skopiuj do schowka
 
 
Artik 



Wersja: Win Office 365
Pomógł: 3091 razy
Posty: 10240
Wysłany: 22-02-2021, 15:43   

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

_________________
Persistence is a virtue in the world of programming.
ID posta: 400844 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2494 razy
Posty: 8280
Wysłany: Wczoraj 22:43   

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.
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 400963 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.marketingNET.pl

Archiwum

Strona używa plików cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przeglądarce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
Sprawdź, w jaki sposób przetwarzamy dane osobowe