Otomatik Yedek Alma ve Yedeklerden Silme

[askm]

Kolay gelsin.Aşağıdaki kodlar ile otomatik olarak yedek alıyorum. Yalnız sürekli yedek aldığı için belli bir süre sonra hafızada yer kaplıyor. Kayıt öncesi klasördeki dosyalara baksa 10 gün den önce kaydedilenleri silebilir mi?

Private Sub Workbook_BeforeClose(Cancel As Boolean) 'Dosya Yedekleme
Set ds = CreateObject("Scripting.FileSystemObject")
StrFolder = ds.GetFolder(ThisWorkbook.Path).ParentFolder.Path
Dim Yedek As String
Trh = Replace(Now, ":", "_") '& "_Personel Takip"
Kyt = StrFolder & "\YEDEKLER\"
'MsgBox Kyt
ThisWorkbook.Save
ds.CopyFile ThisWorkbook.FullName, Kyt & Trh & Environ("username") & ".xlsm"

End Sub

 

[askm]

Aşağıdaki kodlar ile hallettim teşekkürler.
Sub DOSYA_SİL()
Trh = Replace(Now - 10, ":", "_")
[A1] = Left(Trh, 10)

Yol = ThisWorkbook.Path & "\YEDEKLER\"
Dosya = Dir(Yol & "*.*")
Do While Dosya <> ""
For X = 1 To Cells(Rows.Count, 1).End(3).Row
If Left(Dosya, 10) < Cells(1, 1) Then
'If Left(Dosya, Len(Cells(X, 1))) = Cells(X, 1) Then
Kill Yol & Dosya
Exit For
End If
Next
Dosya = Dir
Loop

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Korhan Ayhan]

Şöyle bir öneride bulunabilirim.

Dosyanızı yedeklerken sadece tarihi ve saat bilgisini alırsanız gün içinde tek dosya arşiviniz olur. Saniyeyi devre dışı bıraktığınız için çoklu dosya yedeğinden kurtulmuş olursunuz.

 

[askm]

Dosya ağda kullanılacak bir dosya. O yuzden birden çok yedek olması daha iyi boyut olarak da küçük.

 

[askm]

Birde dediğiniz şekilde dosyanın ismi klasörde mevcut olduğu için dosya mevcut üzerine yazılsın mı uyarısı veriyor. Bunu engellemeyi bilmiyorum.

 

[Korhan Ayhan]

Application.DisplayAlerts = False satırı ile o uyarıyı geçebilirsiniz.