Gelen maili klasörleme

[askm]

Kolay gelsin.
Gelen mailler kurallar ile ilgili klasörlere alınmakta. Aşağıdaki kod ile de bilgisayara yedeklenmekte. Yalnız bu kod çalıştığı zaman hepsini bir klsöre almakta. Bunun yerine ya günlük bir klasör oluşturp ona atma ya da alt klasörler için alt klasör açıp ona atma imkanı olur mu. Teşekkürler.

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


Set kls = CreateObject("Scripting.FileSystemObject")


Dim saveFolder As String
saveFolder = "E:\OUTLOOK YEDEK" 'Maillerin kaydedileceği dosya
Dim dateFormat
dateFormat = Format(itm.ReceivedTime, "ddmmyyyy HH.mm.ss") ' Mailin dosya adına alınma zamanını eklemek için
Dim dosyaadi As String

dosyaadi = saveFolder & "\" & dateFormat & "-" & itm.Sender.Name & "-" & degistir(itm.Subject)

MkDir saveFolder & "\" & dateFormat & "-" & itm.Sender.Name
ChDir saveFolder & "\" & dateFormat & "-" & itm.Sender.Name

saveFolder = saveFolder & "\" & dateFormat & "-" & itm.Sender.Name

dosyaadi = saveFolder & "\" & dateFormat & "-" & itm.Sender.Name & "-" & degistir(itm.Subject) & " .msg"
itm.SaveAs dosyaadi ' Maili diske kaydeder.

For Each objAtt In itm.Attachments 'Mail'deki ekleri diske kaydeder.
objAtt.SaveAsFile saveFolder & "\" & dateFormat & "-" & itm.Sender.Name & "-" & degistir(itm.Subject) & objAtt.DisplayName
Set objAtt = Nothing
Next

End Sub

Function degistir(yazi As String) 'Dosya adındaki geçersiz karakterleri temizler
On Error Resume Next
yk = "_" 'Geçersiz karakterin yerine ne koyacağız?
yazi = Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(yazi, ":", yk), "*", yk), "\", yk), "/", yk), "<", yk), ">", yk), "|", yk), """", yk), "?", yk)
degistir = yazi
End Function

 

[askm]

Yazılan kodda mailler ve ekleri klasöre kaydediliyor. Bunun yerine isim olarak verilen kısmı klasöre verip her mail için ayrı klasöre ekleri ile atma imkanı olur mu.
Aslında outlookda oluşturulan klasörlere göre ayrım yapabilsem daha güzel olacak ama bu şekilde her mail klasörlense de olur.
Teşekkürler.

 

[aytekin44]

Kodlar için teşekkürler.

Belirli bir subject ile gelen mailleri sadece klasörleyebilir miyiz?

Örneğin mailin başlığı "ADANA_Deneme" olsun, ADANA ismini gördüğünde maili klasöre kaydetsin.

Böyle bir işlem yapılabilir ise desteğinizi rica ederim.