Excel - makro na zálohu jednou denně při prvním uložení Vyřešeno

[birgis]

Ahoj znovu

tentokrát bych moc ocenil pomoc s makrem, které by každý den při prvním uložení vytvořilo zálohu do složky backup\rok_mesic\
Soubor se několikrát denně otvírá, ukládá a proto jen při prvním uložení každý den.

Moc děkuji všem za pomoc

[Reklama]

[Uziv00]

Nejsem sice žádný přeborník na makra, ale mohlo by to (snad) být nějak takhle:

Kód: Vybrat vše

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Set fso = CreateObject("scripting.filesystemobject")
' vytvoreni nazvu souboru
Mesic = Month(Now())
If Den < 10 Then Den = "0" & Den
If Mesic < 10 Then Mesic = "0" & Mesic
Namefile = Den & "Jméno_souboru.xls"

' adresar existuje? If not - create
cesta = "D:\backup\" & Year(Now()) & "_" & Mesic & "\"
If (Not fso.FolderExists(cesta)) Then fso.CreateFolder(cesta)

' existuje jiz zaloha?
plne = cesta & Namefile

If Not fso.FileExists(plne) Then
ActiveWorkbook.SaveCopyAs Filename:=plne
End If
End Sub


Mělo by to pracovat asi tak, že při uložení si makro vytvoří jméno souboru i adresáře kopie, zkontroluje, zda existuje adresář a když ne, vytvoří ho. Jméno adresáře je D:\backup\RRRR_MM, jméno souboru DDJmeno_souboru.xls. Poté zkontroluje, zda kopie již existuje, pokud ne, provede uložení kopie. protože aktuální den je v názvu souboru, bude každý den vytvořena jen jedna kopie a to při prvním uložení souboru.
Snad tě to nějak navede.

[birgis]

Ahoj,

Moc děkuju, funguje to jak má, jen jsem se chvíli trápil, než jsem přišel na to, že to musím vložit do ThisWorkBook a ne jako modul.
A ještě jsem tam provedl drobnou opravu před řádek Mesic = Month(Now()) jsem vložil Den = Day(Now())

Kdyby to pomohlo i někomu jinému:))

Díky moc za pomoc