- Katılım
- 26 Eylül 2020
- Mesajlar
- 171
- Excel Vers. ve Dili
- excel 2019 pro.Türkçe
- Altın Üyelik Bitiş Tarihi
- 26-09-2021
Arkadaşlar zaman ayarlı yedekleme yaptırmaya çalışıyorum.Kodu aşağıda paylaşıyorum.Bilgisayarda C sürücüsünde YEDEK adlı klasör oluşturdum.Workbook open kısmınada call yedek diye yazdım..Butona tıklarsam yedekleme yapıyor ama kendiliğinden yedekleme yapmıyor.Yardımlarınızı bekliyorum.
Private Sub yedek_click()
Application.OnTime Now + TimeValue("00:02"), "yedek"
Dim DosyaSistemi As Object, Aktif_Dosya_Adı As String
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Aktif_Dosya_Adı = ThisWorkbook.FullName
Yedek_Dosya_Adı = Replace(ThisWorkbook.Name, ".xls", "") & Format(Date, " dd_mm_yyyy") & "_" & Format(Now, "hh_mm") & ".xls"
Kayıt_Yeri = "C:\YEDEK\" & Yedek_Dosya_Adı
ThisWorkbook.Save
On Error Resume Next
If Dir("C:\YEDEK\") = "" Then MkDir "C:\YEDEK\"
DosyaSistemi.CopyFile Aktif_Dosya_Adı, Kayıt_Yeri
MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation
End Sub
Private Sub yedek_click()
Application.OnTime Now + TimeValue("00:02"), "yedek"
Dim DosyaSistemi As Object, Aktif_Dosya_Adı As String
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Aktif_Dosya_Adı = ThisWorkbook.FullName
Yedek_Dosya_Adı = Replace(ThisWorkbook.Name, ".xls", "") & Format(Date, " dd_mm_yyyy") & "_" & Format(Now, "hh_mm") & ".xls"
Kayıt_Yeri = "C:\YEDEK\" & Yedek_Dosya_Adı
ThisWorkbook.Save
On Error Resume Next
If Dir("C:\YEDEK\") = "" Then MkDir "C:\YEDEK\"
DosyaSistemi.CopyFile Aktif_Dosya_Adı, Kayıt_Yeri
MsgBox "Dosyanız aşağıdaki isimle yedeklenmiştir." & Chr(10) & Kayıt_Yeri, vbInformation
End Sub