İlgili makro çalıştığımız excel'de hata yapılma olasılığına karşı excel kapatılırken herhangi bir butona gerek kalmadan otomatik olarak tarih saat biçiminde istediğiniz yere yedek alır.Bu sayede geçmişe dönük yedeklerden istediğinizi kullanabilirsiniz.
Sadece makroda D:\YEDEK\ adresini kendi istediğiniz klasör adresiyle değiştiriniz.
MERHABALAR,
YanıtlaSilELİNİZE SAĞLIK ÇOK YARALI BİR MAKRO GERÇEKTEN.
ağdaki \\mavim\arsivSİSTEMİ bir servera otomatik kaydederken kod hata veriyor, düzeltilebilir mi acaba, teşekkürler..
Merhaba,
SilÖncelikle teşekkürler.
Örnekte belirttiğim gibi uzak bağlantı adresinin sonunda "\" işareti var."D:\YEDEK\".
Sizin adreste en sondaki işareti göremedim. \\mavim\arsivSİSTEMİ\ şeklinde yazıp denermisiniz.
Merhaba Hocam Kullandığım excel gün içinde 12 saat hep açık ara ara 15 dk bir Ctrl+S ile alışkanlık oldu kaydediyyorum. HEr Kaydettiğimde Otomatik yedek alması mümkün mü.
YanıtlaSilMerhaba,
SilMakro kısmında "This Workbook" Türkçe ise "Bu çalışma kitabı" alanına aşağıdaki makroyu yazıp denermisiniz.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveWorkbook.Save
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
yer = "D:\YEDEK\"
For i = 1 To Len(ThisWorkbook.Name)
If Mid(ThisWorkbook.Name, i, 1) = "." Then
Dosya = Mid(ThisWorkbook.Name, 1, i - 1)
uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
End If
Next
ActiveWorkbook.Save
Application.DisplayAlerts = False
Yedek_Dosya_Adı = Dosya & Format(Now, " dd_mm_yyyy_hh_mm") & uzanti
Kayıt_Yeri = yer & Yedek_Dosya_Adı
On Error Resume Next
If Dir(yer) = "" Then MkDir yer
On Error Resume Next
DosyaSistemi.CopyFile ThisWorkbook.FullName, Kayıt_Yeri
ActiveWorkbook.Password = ""
Application.DisplayAlerts = True
End Sub
Hocam bana yardımcı olabilir msiniz? Excel dosyalarım her gün yedek almasını istiyorum nasıl yapabilirim. Örneğin dosya adım A olacak şekilde her gün 17.00 da
YanıtlaSilMerhaba,
SilBu işlem için ilgili Excel in kod kısmında bir adet Module ekleyin.
Ve içerisine aşağıdaki kodu yapıştırın.
Dim ZamanlamaSaati As Date
' Yedekleme sürecini başlatır
Sub Otomatik_Yedekleme_Baslat()
' Her gün 17:00'da çalışacak şekilde zamanlanır.
ZamanlamaSaati = TimeValue("17:00:00")
Application.OnTime ZamanlamaSaati, "Yedek_Al"
End Sub
' Yedekleme işlemini yapan makro
Sub Yedek_Al()
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dim Yedek_Dosya_Adı As String, Kayıt_Yeri As String
Dim yer As String, Dosya As String, uzanti As String
yer = "D:\YEDEK\" ' Yedeklerin kayıt yeri
' Dosya adını ve uzantısını ayırır
For i = 1 To Len(ThisWorkbook.Name)
If Mid(ThisWorkbook.Name, i, 1) = "." Then
Dosya = Mid(ThisWorkbook.Name, 1, i - 1)
uzanti = Mid(ThisWorkbook.Name, i, Len(ThisWorkbook.Name))
End If
Next
ActiveWorkbook.Save
Application.DisplayAlerts = False
' Yedek dosya adı oluşturulur: "Mevcut dosya adı_A"
Yedek_Dosya_Adı = Dosya & "_A" & uzanti
Kayıt_Yeri = yer & Yedek_Dosya_Adı
' Eğer "YEDEK" klasörü yoksa oluşturur
On Error Resume Next
If Dir(yer) = "" Then MkDir yer
On Error Resume Next
' Dosyayı kopyalar
DosyaSistemi.CopyFile ThisWorkbook.FullName, Kayıt_Yeri
Application.DisplayAlerts = True
' Ertesi gün için zamanlama yeniden ayarlanır
Otomatik_Yedekleme_Baslat
End Sub
Excel her açıldığında bu makronun çalışması için de Excel kod bölümünde "This Workbook" içine aşağıdaki kodu yapıştırın.
Private Sub Workbook_Open()
Otomatik_Yedekleme_Baslat
End Sub
Tüm bu kodların sorunsuz çalışması için excelinizin uzantısı XLSM olmalıdır.Yani exceli farklı kaydet yaparak makro etkin modda kaydetmelisiniz.
hocam açıklama kısımlarını siliyorum değil mi
Silhocam beceremedim galiba destek olabilme şansınız varmı?
Silşimdi otomatik kayıt alacağım exceli açtım geliştirici kısmından visual basice geliyorum, sonra sayfada sağ yıklayıp module açıyorum buraya verdiğiniz kodu direk yapıştırayım mı?
SilSize paylaştığım kodun en altında bu kod var. Bunu Module kısmına yapıştırmayın.Açıklamaların başında ' tırnak işareti varsa kalabilir.Oradaki kodun ne anlama geldiğini açıklamak için yazıldı.
YanıtlaSilBu kodu Exceldeki "This Workbook" içine yapıştırın.
Private Sub Workbook_Open()
Otomatik_Yedekleme_Baslat
End Sub