Outlook daki mailin alınan tarihe göre içerik bilgilerini excele almak

[a_self_lion]

Selam arkadaşlar,

Outlook dan Kişisel Klasörler altında bulunan Logs klasörümdeki maillerimi alınma tarihine göre içeriğini excele alabilirmiyim.
Gelen mailler Logs klasörüne 1 saat ara ile aşağıdaki formatta içeriğinde loglar geliyor.
Bu maillerin içeriğinde olan logları bir gün sonra excede yazacağım tarih ile bunları ordan excele aktarmak istiyorum satır satır.
Mümkünse alınanlarıda silmek.

Gelen mailler Aşağıda resimide eklediğim şekil de gelmekte kısaca bahsecek olursam,

Kod: [Seç]

Kimden  Konu                     Alınan Tarih
......     P-661H-D1:LOGS     sal 26.07.2011 09:09
......     P-661H-D1:LOGS     sal 26.07.2011 10:09
......     P-661H-D1:LOGS     sal 25.07.2011 09:09
......     P-661H-D1:LOGS     sal 25.07.2011 09:09
Yukardaki Alınan tarih benim excele verdiğim tarih aralığında ise excele alınsın ve silinsin.

İçerik ise



Kod:
 

Kod: [Seç]

No. Time Source           IP Destination IP   Note
1   |05/05/2011 01:00:02 |192.198.10.229    |exceeds the max. |
Resim olarakta yükledim


resim link
http://imageshack.us/photo/my-images/705/maillogs.jpg/
resim link
http://imageshack.us/photo/my-images/705/maillogs.jpg/


Nasıl bunları excele alabilirim ki ona göre rapor yapacaktım.
Yardımlarınızı bekliyorum.

[Bülent Öztürk]

Aleyküm selam Özkan Bey.

Kodları çalışmanıza uyarlayıp deneyin lütfen;

Kod: [Seç]

Sub Excelce_Outlooktan_Veri_Al()
Set ExcelceMAPI = GetNamespace("MAPI")
Set Gelenler = ExcelceMAPI.GetDefaultFolder(olFolderInbox)
Set HedefKlasor = Gelenler.Folders("Logs")

For bulent = HedefKlasor.Items.Count To 1 Step -1
    Set Mail = HedefKlasor.Items(bulent)
    Tarih = VBA.FormatDateTime(Mail.ReceivedTime, vbShortDate)
    Select Case CDate(Tarih)
    Case Range("Tarih1").Value - 1 To Range("Tarih2").Value
        say = Worksheets("Sayfa1").Range("A65530").End(3).Row + 1
        Worksheets("Sayfa1").Range("A" & say) = HedefKlasor.Items(bulent).SenderEmailAddress
        Worksheets("Sayfa1").Range("B" & say) = HedefKlasor.Items(bulent).Subject
        Worksheets("Sayfa1").Range("C" & say) = HedefKlasor.Items(bulent).ReceivedTime
        Worksheets("Sayfa1").Range("D" & say) = HedefKlasor.Items(bulent).Body
        HedefKlasor.Items(bulent).Delete
    End Select
Next
End Sub

[esrarengizdj]

Merhaba, bende bu dertten muzdaribim bir çözüm bulamadım. tam 4000 mail geldi ve mail içeriğini excele atmam lazım. içerikte telefon numaraları var. yoksa tek tek 4000 maili tıklayıp kopyala yapıştır yapmam lazım ki imkansız.  yukarıdaki makroyu çözemedim bana uygun olanı paylaşabilirmisiniz rica etsem.

Outlook 2010 kullanıyorum

mail alacağım klasör bilgileri aşağıdaki gibidir.
info@izinsizsms.com hesabınında Gelen Kutusu  ekte resim paylaşıyorum. Yardım ederseniz çok sevinirim.