Koşula Göre Dosya Silme

[baydeniro]

Merhaba arkadaşlar. Belli bir koşula göre aynı katalog altındaki dosyaları silmek mümkün mü ? Örneğin Belgelerim kataloğu altında ADANA_5, ADANA_22 ve ADANA_41 isimli excel dosyaları mevcut. Bu 3dosyadan ADANA_22 olan en yeni tarihli olanı. Diğer 2 sini yani ADANA_5 ve ADANA_41 isimli excel dosyalarını makro ile silmek (KILL) mümkün mü ?

 

[baydeniro]

Merhaba arkadaşlar. Belli bir koşula göre aynı katalog altındaki dosyaları silmek mümkün mü ? Örneğin Belgelerim kataloğu altında ADANA_5, ADANA_22 ve ADANA_41 isimli excel dosyaları mevcut. Bu 3 dosyadan ADANA_22 olan en yeni tarihli olanı. Diğer 2 sini yani ADANA_5 ve ADANA_41 isimli excel dosyalarını makro ile silmek (KILL) mümkün mü ?

 

[Ömer]

Merhaba,

En yeni tarihliden kastınız nedir? Soruyu biraz daha açarmısınız.

 

[baydeniro]

Teşekkürler sayın Ömer. Aşağıdaki gibi,


ADANA_22 son kayıt tarihi : 27.02.2012 kalmalı
ADANA_5 son kayıt tarihi : 11.02.2012 silinmeli
ADANA_41 son kayıt tarihi : 08.02.2012 silinmeli

 

[Ömer]

Bu şekilde deneyin.

Sub Dosya_Sil()
 
    Dim Dosya As String, DosyaAd As String, Yol As String
    Dim Tar As Date, i As Integer, dz() As String
 
    Yol = "C:\deneme"
 
    Application.ScreenUpdating = False
    If Right(Yol, 1) <> "\" Then Yol = Yol & "\"
    Dosya = Dir(Yol)
    If Dosya = "" Then MsgBox "Yanlış Dosya Yolu...": Exit Sub
 
    Do While Dosya <> ""
        If UCase(Dosya) Like "*.XL*" Then
            i = i + 1
            ReDim Preserve dz(1 To 2, 1 To i)
            dz(1, i) = Dosya
            dz(2, i) = FileDateTime(Yol & Dosya)
            If FileDateTime(Yol & Dosya) > Tar Then
                Tar = FileDateTime(Yol & Dosya)
                DosyaAd = Dosya
            End If
        End If
        Dosya = Dir()
    Loop
 
    For i = 1 To UBound(dz, 2)
        If Not dz(2, i) = Tar Then Kill Yol & dz(1, i)
    Next i
 
End Sub

.

 

[baydeniro]

Mükemmel, harikulade, muhteşem. Allah sizden razı olsun sayın Ömer. Sağlıcakla kalın.

 

[erturk_emre]

Herkese merhabar ve iyi bayramlar,
Konu ile ilgili olduğunu düşündüğüm için buraya yazayım dedim. Benim de silme ile ilgili bir sorum var. Bir excel sheet içinde A1 den A2000 e kadar dosya isimleri var. Örnek olarak A1 de EEE0001 yazıyor. Belirli bir klasörün içinde bu isimde başlayan bütün dosyaları nasıl silebilirim. Örneğin New Folder içinde EEE0001_111, EEE0001AAAA gibi dosyalar var. Makro ile bunları silmem mümkün müdür ? Tabi 2000 satır için de aynı kuralın devam etmesi gerekecek. Alttaki makroya bu uyarlanabilir mi?

Teşekkürler...

 

[burcin_end_muh]

Bu şekilde deneyin.

Sub Dosya_Sil()
 
    Dim Dosya As String, DosyaAd As String, Yol As String
    Dim Tar As Date, i As Integer, dz() As String
 
    Yol = "C:\deneme"
 
    Application.ScreenUpdating = False
    If Right(Yol, 1) <> "\" Then Yol = Yol & "\"
    Dosya = Dir(Yol)
    If Dosya = "" Then MsgBox "Yanlış Dosya Yolu...": Exit Sub
 
    Do While Dosya <> ""
        If UCase(Dosya) Like "*.XL*" Then
            i = i + 1
            ReDim Preserve dz(1 To 2, 1 To i)
            dz(1, i) = Dosya
            dz(2, i) = FileDateTime(Yol & Dosya)
            If FileDateTime(Yol & Dosya) > Tar Then
                Tar = FileDateTime(Yol & Dosya)
                DosyaAd = Dosya
            End If
        End If
        Dosya = Dir()
    Loop
 
    For i = 1 To UBound(dz, 2)
        If Not dz(2, i) = Tar Then Kill Yol & dz(1, i)
    Next i
 
End Sub

.

Merhaba Ömer bey,

For i = 1 To UBound(dz, 2) satırında subscript out of range hatası alıyorum.

bi de kullanıcı adı değişken olmasını nasıl sağlayabiliriz?



Sub Dosya_Sil()

Dim Dosya As String, DosyaAd As String, Yol As String
Dim Tar As Date, i As Integer, dz() As String

Yol = "C:\Users\burcinyumusak\Downloads"

Application.ScreenUpdating = False
If Right(Yol, 1) <> "\" Then Yol = Yol & "\"
Dosya = Dir(Yol)
If Dosya = "" Then MsgBox "Yanlış Dosya Yolu...": Exit Sub

Do While Dosya <> ""
If UCase(Dosya) Like "*.csv*" Then
i = i + 1
ReDim Preserve dz(1 To 2, 1 To i)
dz(1, i) = Dosya
dz(2, i) = FileDateTime(Yol & Dosya)
If FileDateTime(Yol & Dosya) > Tar Then
Tar = FileDateTime(Yol & Dosya)
DosyaAd = Dosya
End If
End If
Dosya = Dir()
Loop

For i = 1 To UBound(dz, 2)
If Not dz(2, i) = Tar Then Kill Yol & dz(1, i)
Next i

End Sub