Arşivimde şöyle bir makro buldum dener misiniz ?

Sub Test()

 '

 ' Raider ® - 26/09/2006

 '

 Dim OutApp As Object, OutFolder As Object

 Dim MyMail As Object, MailItems As Object

 Dim i As Long, j As Long

 Dim Temp As Variant

 

 Cells.ClearContents

 Set OutApp = CreateObject("Outlook.Application")

 Set OutFolder = OutApp.GetNamespace("MAPI").GetDefaultFolder(6)

 Set MailItems = OutFolder.Items

 

 For Each MyMail In MailItems

 If LCase(MyMail.Subject) = "test" Then

 i = i + 1

 Temp = MyMail.body

 Temp = Replace(Temp, Chr(13), Empty)

 Cells(i, 1) = Left(Temp, Len(Temp) - 1)

 End If

 Next

 MsgBox "Konusu - (Subject) ''test'' olan tüm e-maillerin içeriği sayfaya işlendi"

End Sub