txt dosyalarında arama yapma ve uygun olanları silme

[mkbal]

Merhaba arkadaşlar

belirli bir klasördeki tüm *.txt dosyaların içinde belirli bir ifadeyi aratıp, içerisinde aradığım ifade var ise o dosyaları silen bir koda ihtiyacı var

Yardımlar için şimdiden teşekkür ederim...

 

[mkbal]

yazmaya çalıştığım kod (sadece silme işlemi eksik)

Sub dosyasayisi()
b = "deneme" 'aranan ifade
'**************TOPLAM DOSYA SAYISI*************************************
yol = "C:\Outgoing\"
ChDir yol
dosya = Dir("*.txt")

While dosya <> ""
Sayi = Sayi + 1
Dosyalar = sonuc & dosya & vbLf
dosya = Dir
Wend
'**************SİLİNECEK DOSYA SAYISI***********************************
yol2 = "C:\Outgoing\"
ChDir yol2
dosya2 = Dir("*.txt")

If Dir(yol2 & dosya2) <> "" Then 'dosya varsa
Open yol2 & dosya2 For Input As 1#
While Not EOF(1) 'dosya sonuna kadar
Input #1, a
If b = a Then sil = sil + 1:
Wend
Close #1
Else
End If

'************************************************************************
MsgBox "Bakılan Klasör: " & yol & vbLf & "Bulunan Dosya Sayısı: " & Sayi & vbLf & "Silinecek Dosya Sayısı: " & sil
End Sub

 

[halit3]

Bu kod işine yararmı.?
Silinen dosyaları A ve B sutünuna listeliyor.

Dim aranan As String
 
Sub Dosya_Listele()
aranan = InputBox("aranan kelimeyi yazın.", "UYARI!", "")
If aranan = "" Then
Exit Sub
End If
Columns("A:A").ClearContents
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
If Right(Kaynak, 1) <> "\" Then Kaynak = Kaynak & "\"
Liste (Kaynak)
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
Private Sub Liste(yol As String)
Dim fL As Object, fs As Object, f As Object, j As Long, n As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(yol).subfolders
Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(yol).Files
For Each Dosya In fs
If UCase(Right(Dosya.Name, 3)) = UCase("txt") Then
i = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
say = 0
Open Dosya For Input As #1
Do While Not EOF(1)
Line Input #1, a
On Error Resume Next
adres = Trim(a)
son1 = InStr(InStr(Trim(adres), aranan), adres, "", vbTextCompare)
If son1 <> 0 Then
say = 1
Exit Do
End If
Loop
Close
If say = 1 Then
Cells(i, 1).Value = Dosya
Cells(i, 2).Value = Dosya.Name
CreateObject("Scripting.FileSystemObject").DeleteFile Dosya
End If
End If
Next
On Error GoTo sonraki
For Each f In fL
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub

 

[ertane]

sorun çözüldü teşekkürler

 

[mkbal]

Teşekkürler. Daha profesyonel olarak amaca hizmet ediyor.
Peki benim yazdığım kodda bir yere kill komutu yazarak işlemi halledemeyiz mi?

 

[halit3]

Teşekkürler. Daha profesyonel olarak amaca hizmet ediyor.
Peki benim yazdığım kodda bir yere kill komutu yazarak işlemi halledemeyiz mi?

Bir yorum yapamıyacağım.