Mail eklerini sabit diske kaydetme

[burcin_end_muh]

Merhabalar,

Buna benzer bir konuyu daha önce de açmıştım ancak geri dönüş olmadı. Tekrar bu konuda bir ihtiyacım doğdu.
Sistem belirli saatlerde bana 3 farklı bilgili ayrı maillerde atıyor.
Ben bunların içindeki datayı kendi raporumdaki ilgili sayfaya yapıştırıp raporu yayınlıyorum.

sistemin attığı excel raporlarını masa üstünde bir klasöre indirmek mümkün müdür?
bir çalışma buldum belki siz uyarlayabilirsiniz?

Hatta outlook ta makro yazıldığını gördüm
onunla ilgili bulduğum kod aşağıdadır:

Public Sub SaveMailDisk(itm As Outlook.MailItem)
On Error Resume Next
Dim saveFolder As String
saveFolder = "C:\Users\burcinyumusak\Desktop\today" '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