Excel Vba Forum - Excelce.Net
SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: a_self_lion - 27 Temmuz 2011, 16:52:30
-
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,
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:
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
(http://imageshack.us/photo/my-images/705/maillogs.jpg/)
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.
-
Aleyküm selam Özkan Bey.
Kodları çalışmanıza uyarlayıp deneyin lütfen;
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
-
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.