Soru Dosya Kaydet Yedek Al

[bulentkars]

Arkadaşlar Merhaba,

Aktif Açık olan Hesaplar.xlsm dosyasını 3 yere yedeklemek istiyorum. yardımcı olabilirseniz sevinirim. Şİmdiden Teşekkürler

1 - Hesaplar.xlsm Mevcut isim ile mevcut var olan yere kaydedecek.
2- Hesaplar.xlsm ismi ile O:\ORTAK\TALIMATLAR\ARACLAR\ Klasörü İçerisine Kaydedecek.
3 - Dosya Adı Yedek - Bugünün tarihi ve saati olacak şekilde
O:\ORTAK\TALIMATLAR\ARACLAR\Hesap\Yedek\ Klasörü İçerisine Kaydedecek.

 

[Asri]

Dosya yollarını düzenlersiniz.

Sub kaydetyedek()
    On Error GoTo hata1
    ActiveWorkbook.Save
  
    yolfarkli = "D:\Deneme\toplu\" & ActiveWorkbook.Name
  
    zamanstr = Replace(Replace(Replace(Now, ".", "_"), ":", "_"), " ", "_") & "_"
    yedekyol = "D:\Deneme\toplu\yedek\Yedek - " & zamanstr & ActiveWorkbook.Name
  
    On Error GoTo hata2
    CreateObject("Scripting.FileSystemObject").CopyFile ActiveWorkbook.FullName, yolfarkli, True
  
    On Error GoTo hata3
    CreateObject("Scripting.FileSystemObject").CopyFile ActiveWorkbook.FullName, yedekyol, True
  
    On Error GoTo 0
    Exit Sub
  
hata1:
    MsgBox ("Kendi adı ile kaydet işleminde hata oldu.")
    On Error GoTo 0
    Exit Sub
  
hata2:
    MsgBox ("Farklı klasöre kaydet işleminde hata oldu.")
    On Error GoTo 0
    Exit Sub
  
hata3:
    MsgBox ("Yedek kaydet işleminde hata oldu.")
    On Error GoTo 0
    Exit Sub
End Sub

 

[bulentkars]

Merhaba,

Çok Teşekkür ederim, elinize sağlık..