Gelen mailleri klasörleme

[askm]

Kolay gelsin. Aşağıdaki kodlar ile gelen maillere klasör oluşturup, bu klasörler içerisine yedekliyorum. Kural çalıştırdan alt klasörleri ile birlikte çalıştır yapıöyorum Yalnız bazı mail içeriklerini almıyor. kodda mı hata var yoksa hata nerde acaba.

Public Sub Outlok_Yedek(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 & "\" & itm.Sender.Name '
ChDir saveFolder & "\" & itm.Sender.Name '




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


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


'MkDir saveFolder '

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


saveFolder = saveFolder & "\" & dateFormat & "-" & itm.Subject




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

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]

Gelen bazı mailler için kişinin adına klasör oluşturuyor. Yalnız gelen maili içerisine almıyor. Boş klasör oluşuyor.

 

[mustafasahin5341]

Arkadaşlar harici diskimde bulunan klasör kullanılmaz hale geldi. Tekrar geri kullanıma nasıl alabilirim. Teşekkürlerr.