Kullanıcı
- Katılım
- 28 Tem 2022
- Mesajlar
- 120
- Excel Versiyonu
- Excel 2016
- Excel Sürümü
- 64 Bit
- Excel Dili
- Türkçe
Merhaba, Aşağıda açılışta otomatik yedek alma makro kodu, c:\excel_yedek\ dosya yoluna kayıt yapması için kodda nasıl bir değişiklik yapmamaz lazım geldiğini çözemedim. Kod incelerseniz, açılışta tarih-saat yedeği almakta ve 10 kayıttan sonra eski tarih olan ilk kayıttan itibaren silmektedir. En azından öyle olmasını bekliyorum. Kod üzerinde, yanlış veya eksiklik olup, olmadığı ile yedek kayıt yolu olarak (c:\excel_yedek\ ) ilgili kod alanında uygulanması konusunda yardımcı olursanız memnun olurum.
Sub acilis()
On Local Error Resume Next
Dim evn As Object, klasor As Object, dosya As Object, xls As Object
Dim ad As String, a As String, say As Integer, deger As Date
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.getfolder(ThisWorkbook.Path)
Set dosya = evn.getfile(ThisWorkbook.FullName)
ad = Mid(dosya.Name, 1, InStrRev(dosya.Name, ".", -1, 1) - 1)
For Each xls In klasor.Files
a = Mid(xls.Name, 1, InStr(1, xls.Name, "-", 1) - 1)
If a <> Empty And a = ad Then
say = say + 1
If deger = Empty Or deger > xls.datecreated Then
deger = xls.datecreated
silinecek = xls.Path
End If
End If
a = Empty
Next xls
If say >= 10 Then evn.deletefile silinecek
evn.copyfile dosya.Path, ThisWorkbook.Path & _
"\" & ad & "-" & Format(Now, "dd.mm.yyyy hh-mm") & ".xls"
Set evn = Nothing: Set klasor = Nothing: Set dosya = Nothing
ad = vbNullString: silinecek = vbNullString: a = vbNullString
say = Empty: deger = Empty
End Sub
Sub acilis()
On Local Error Resume Next
Dim evn As Object, klasor As Object, dosya As Object, xls As Object
Dim ad As String, a As String, say As Integer, deger As Date
Set evn = CreateObject("scripting.filesystemobject")
Set klasor = evn.getfolder(ThisWorkbook.Path)
Set dosya = evn.getfile(ThisWorkbook.FullName)
ad = Mid(dosya.Name, 1, InStrRev(dosya.Name, ".", -1, 1) - 1)
For Each xls In klasor.Files
a = Mid(xls.Name, 1, InStr(1, xls.Name, "-", 1) - 1)
If a <> Empty And a = ad Then
say = say + 1
If deger = Empty Or deger > xls.datecreated Then
deger = xls.datecreated
silinecek = xls.Path
End If
End If
a = Empty
Next xls
If say >= 10 Then evn.deletefile silinecek
evn.copyfile dosya.Path, ThisWorkbook.Path & _
"\" & ad & "-" & Format(Now, "dd.mm.yyyy hh-mm") & ".xls"
Set evn = Nothing: Set klasor = Nothing: Set dosya = Nothing
ad = vbNullString: silinecek = vbNullString: a = vbNullString
say = Empty: deger = Empty
End Sub
