Soru Klasör içindeki tüm alt klasörlerin içindeki metinler silmek

[bulentkars]

Arkadaşlar Merhaba,

Makinamda güncelleme yapıldı, tüm belgelerimin birer kopyası aşağıdaki şekilde sehven çoğaldı, ben bunları tüm klasörlerin içindeki klasörlerden nasıl silebilirim acaba yardımcı olabilirseniz sevinirim. Şİmdiden Teşekkürler.

Yer : U:\Belgelerim\ Altındaki tüm klaösörler

Aşağıdaki isim ile başlayan tüm belgeleri otomatik silmek istiyorum. Bunların uzantısı xls,jpg,doc,pps,mp3, Uzantısına bakmaksızın aşağıdaki metnni içeren dosyaların silinmesini istiyorum.
2023-01-13 18-41 Copy of

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit
Dim Dosya As Object, Alt_Klasorler As Object, Say As Long, Onay As Byte, Aranan_Metin As String, Zaman As Double
   
Sub Klasor_Secimi()
    Aranan_Metin = "2023-01-13 18-41 Copy of"

    Onay = MsgBox("Seçeceğiniz klasör ve alt klasörlerindeki adında " & Aranan_Metin & " ifadesi geçen tüm dosyalar silinecektir!" & vbCrLf & vbCrLf & _
                  "İşlemi onaylıyor musunuz?", vbCritical + vbYesNo + vbDefaultButton2)
   
    If Onay = vbNo Then Exit Sub
   
    Say = 0
       
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then
            Call Dosyalari_Sil(.SelectedItems(1), True)
        End If
    End With

    Zaman = Timer
   
    MsgBox Say & " adet dosya silinmiştir." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Sub Dosyalari_Sil(Klasor As String, Alt_Klasorler_Dahilmi As Boolean)
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).Files
        If InStr(1, Dosya, Aranan_Metin) > 0 Then
            Say = Say + 1
            CreateObject("Scripting.FileSystemObject").DeleteFile Dosya, True
        End If
    Next
   
    If Alt_Klasorler_Dahilmi Then
        For Each Alt_Klasorler In CreateObject("Scripting.FileSystemObject").GetFolder(Klasor).SubFolders
            Call Dosyalari_Sil(Alt_Klasorler.Path, True)
        Next
    End If
End Sub

 

[bulentkars]

Çok Teşekkür Ederim Korhan Bey, Elinize emeğinize sağlık