Kapalı Dosya isimlerini Silmek

[5353]

Bir excel dosyam var bir makro var aşağıdaki hücrelerde yazılan dosya isimlerini siliyor.

Silinecek Dosya Adlarını yazınız.
*.docx
Report.xls
Report*.*.xls


ben bu dosya adlarını yazıyorum fakat başka bir program
Report.xls
Report(1).xls
Report(2).xls
Report(3).xls
Report(4).xls
........ gibi dosya üretiyor.

Ben sil butoruna basında bütününü bir defada Report ???? hücreye ne yazarak silebilirim.

 

[5353]

Dim dosyaadi As String
Dim dosyasayisi, kackelime, ensonsatir, ensonsutun, satir As Long
Dim buyukharf, uzanti, yontem, aradizin, gosterimsekli, tumdosya As String
Dim aranacaklar(10000) As String
Dim textuzantilar
Dim birkere, birkereiptal As Boolean


Sub menu()
Sheets("Menu").Select
aradizin = Cells(2, 2).Value & "\"
buyukharf = Cells(2, 3).Value

cevap = MsgBox(aradizin & " ve altındaki klasörlerde, kritere uyan tüm dosyalar geri dönüşümsüz silinecektir. Onaylıyor musunuz?", vbInformation + vbYesNo)
If cevap = vbYes Then
Else
Exit Sub
End If

tumdosya = "*.*"
satir = 0
birkere = False
birkereiptal = False

Call sifirlaaranan
Call aranacaklari_yukle
Call RecursiveFolder(aradizin)
If satir = 0 And (Not birkereiptal) Then
MsgBox ("Silinecek dosya/dosyalar bulunamadı.")
End If

If satir > 0 And (Not birkereiptal) Then
MsgBox ("Silme işlemi tamamlandı.")
End If

If birkereiptal Then
MsgBox ("Silme işlemi iptal edildi.")
End If


End Sub

Sub sifirlaaranan()
For i = 1 To 10000
aranacaklar(i) = ""
Next i
End Sub

Sub aranacaklari_yukle()
kackelime = Cells(Rows.Count, "A").End(3).Row - 1
For i = 1 To kackelime
bul = Cells(i + 1, 1).Value
aranacaklar(i) = bul
Next i
dosyasayisi = i - 1
End Sub

Sub RecursiveFolder(MyPath)
Dim FileSys As FileSystemObject
Dim objFolder As Folder
Dim objSubFolder As Folder
Dim objFile As File

Set FileSys = CreateObject("Scripting.FileSystemObject")
Set objFolder = FileSys.GetFolder(MyPath)

For Each objFile In objFolder.Files
If buyukharf = "Evet" Then objdosya = buyukharfler(objFile.Name) Else objdosya = objFile.Name

If Left(objdosya, 1) <> "~" And objdosya <> ThisWorkbook.Name Then
dosyaadi = ""
dosyauzantisi = ""
If InStr(objdosya, ".") > 0 Then
dosyauzanti = Right(objdosya, Len(objdosya) - InStrRev(objdosya, "."))
dosyaadi = Left(objdosya, InStrRev(objdosya, ".") - 1)
Else
dosyauzanti = "uzantısız"
End If

For i = 1 To dosyasayisi
dosya = aranacaklar(i)
If buyukharf = "Evet" Then dosya = buyukharfler(dosya)
sildosyaadi = ""
siluzanti = ""
If InStr(dosya, ".") > 0 Then
siluzanti = Right(dosya, Len(dosya) - InStrRev(dosya, "."))
sildosyaadi = Left(dosya, InStrRev(dosya, ".") - 1)
Else
siluzanti = "uzantısız"
End If

If sildosyaadi = "*" And siluzanti = "*" Then
If Not birkere Then
cevap = MsgBox("*.* kullanılmış. " & aradizin & " ve altındaki klasörlerdeki, tüm dosyalar geri dönüşümsüz silinecektir. Onaylıyor musunuz?", vbInformation + vbYesNo)
If cevap = vbYes Then
birkere = True
Else

birkere = True
birkereiptal = True
Exit Sub
End If
End If

objFile.Delete
satir = satir + 1
GoTo son
End If


If sildosyaadi = "*" And dosyauzanti = siluzanti Then
objFile.Delete
satir = satir + 1
GoTo son
End If

If sildosyaadi = dosyaadi And siluzanti = "*" Then
objFile.Delete
satir = satir + 1
GoTo son
End If

If dosya = objdosya Then
objFile.Delete
satir = satir + 1
GoTo son
End If

Next i
End If
son:
Next objFile

For Each objSubFolder In objFolder.SubFolders
If birkereiptal Then Exit Sub
RecursiveFolder MyPath & "\" & objSubFolder.Name
Next objSubFolder

Set FileSys = Nothing
Set objFolder = Nothing
Set objSubFolder = Nothing
Set objFile = Nothing

End Sub

Public Function buyukharfler(cumle)
gecici = ""
For i = 1 To Len(cumle)
h = Mid(cumle, i, 1)
Select Case h
Case "ğ": gecici = gecici + "Ğ"
Case "ü": gecici = gecici + "Ü"
Case "ş": gecici = gecici + "Ş"
Case "ç": gecici = gecici + "Ç"
Case "ö": gecici = gecici + "Ö"
Case "ı": gecici = gecici + "I"
Case "i": gecici = gecici + "İ"
Case Else: gecici = gecici + UCase(h)
End Select
Next i
buyukharfler = gecici
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D1]) Is Nothing Then Exit Sub
If Target.Value = "SİL" Then
Call menu
Target = "BEKLE"
End If
End Sub


MAKRO bu çalışıyor fakat A2 A3 A4 A5 ... Silinecek dosya adını ne yazmalıyım. Report...xls çoğalan dosyaları silsin.

 

[Zeki Gürsoy]

Komut satırı da deneyebilirsiniz.

del /f /q C:\BirKlasor\Report*.xls

 

[5353]

Komut satırı da deneyebilirsiniz.

del /f /q C:\BirKlasor\Report*.xls

Teşekkürler bu komut fikir verdi.. komik ama Silineceklere *.xls yazdım böylece; Report.xls
Report(1).xls
Report(2).xls
Report(3).xls
....... diye Report dosyaları da silinmiş oldu.