Belirli Bir Kurala Göre Klasör İçindeki Dosyaların Silinmesi

[bünyamin68]

Değerli arkadaşlarım merhaba Bana Outlook'tan sabit mail adresinden Excel eki olan mailler geliyor ben bu Excel eklerini makroyla ve bir kuralla masaüstünde bir dosyaya alıyorum günde 10 kez ya da daha fazla geldiği oluyor bu mailin dolayısıyla masaüstündeki dosya gereksiz bir sürü Excel dosyasıyla doluyor. Ben olanağı varsa şu şekilde olmasını istiyorum. Şöyle ki;

Mail geldiğinde oluşturduğum kural işleme alınınca ve makro çalıştığında önce klasör içindeki Excel dosyaları silinsin (Burada klasörün boş olması ihtimaline karşı makronun hataya düşmemesi için boş dolu kontrolü de gerekebilir) ardından gelen maille yeni Excel dosyası eklesin. İstiyorum bu mümkün müdür? Mümkünse yardımlarınızı bekliyorum. Yardımlarınız için şimdiden teşekkür ederim mail geldiğinde Excel eklerini otomatik aldığım makro kodları aşağıdadır.

Kod: Tümünü seç

Public Sub asama_raporu(itm As Outlook.MailItem)
On Error Resume Next

Dim saveFolder As String

saveFolder = "C:\Users\bunya\Desktop\ASAMA RAPORU" 'Maillerin kaydedileceği dosya
Dim dateFormat
dateFormat = Format(itm.ReceivedTime, "yyyy-mm-dd HH-mm-ss") ' Mailin dosya adına alınma zamanını eklemek için
Dim dosyaadi As String
 
For Each objAtt In itm.Attachments 'Mail'deki ekleri diske kaydeder.

If LCase(Right(objAtt.FileName, 4)) = ".xls" Or LCase(Right(objAtt.FileName, 5)) = ".xlsx" Then
objAtt.SaveAsFile saveFolder & "\[" & dateFormat & "] " & objAtt.DisplayName
End If
Set objAtt = Nothing
Next

End Sub

[erseldemirel]

Bu kod ile atanan yolda xls ile başlayan dosyaları siler

Kod: Tümünü seç

Sub Sil()
   Klasor = "C:\Users\bunya\Desktop\ASAMA RAPORU\"
        If Not Dir(Klasor, vbDirectory) = "" Then
        Set FSO = CreateObject("Scripting.FileSystemObject")
        DosyaAdi = Dir(Klasor & "*.*")
        Do While DosyaAdi <> ""
            DosyaYolu = Klasor & DosyaAdi
            DosyaUzantisi = Right(DosyaYolu, Len(DosyaYolu) - InStrRev(DosyaYolu, "."))
            If UCase(DosyaUzantisi) Like "XLS*" Then
                Set Dosya = FSO.GetFile(DosyaYolu)
                Dosya.Delete
            End If
            DosyaAdi = Dir
        Loop
        Set FSO = Nothing
    Else
     MsgBox "Klasör bulunamadı"
    End If
End Sub

[karisma61]

İndirilenler klasörü içindeki her şeyi temizliyor.

Kod: Tümünü seç

Sub indirilenlerisil()
Dim aFile As String
aFile = "K:\İndirilenler\*.*"
If Len(Dir$(aFile)) > 0 Then
    Kill aFile
End If
End Sub