merhaba arkadaşlar, Outlook 2007 kullanıyorum, amacım gönderilen iletilerin bir kopyasını otomatik olarak istediğim diske kaydetmek, bir makro buldum ve outlook üzerinde gerekli kuralları da oluşturabiliyorum ama hiç çalışma belirtisi yok, bu konuda yardımcı olabilecek varsa çok memnun olurum, teşekkürler.


Public Sub SaveMailDisk(itm As Outlook.MailItem)
On Error Resume Next
Dim saveFolder As String
saveFolder = "D:\OUTLOOK YEDEK\" '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
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