How to Iterate mailitems certain folder

[elmnas]

Hello people,

I wonder how to iterate a certain outlook folder
for each email that contains a emailadress
list it in a excelsheet?



I believe this is a beginning though:



Sub test()


Dim objNS As Outlook.NameSpace: Set objNS = GetNamespace("MAPI")
Dim olFolder As Outlook.MAPIFolder
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Dim Item As Object


For Each Item In olFolder.Items
If TypeOf Item Is Outlook.MailItem Then
Dim oMail As Outlook.MailItem: Set oMail = Item
MsgBox oMail.SenderEmailAddress
End If
Next


End Sub


I have been trying following stuff:

http://www.slipstick.com/developer/print-list-of-outlook-folders/
http://www.gregthatcher.com/Scripts/VBA/Outlook/GetListOfOutlookEmails.aspx (http://www.gregthatcher.com/)

Could someone help me?

Thank you in advance

[gmayor]

So far so good. Now you need to add the Excel part e.g.


Option Explicit

Sub test()

Dim xlApp As Object
Dim xlWb As Object
Dim xlSheet As Object
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim Item As Object
Dim iLastRow As Long

Set objNS = GetNamespace("MAPI")
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
xlApp.Visible = True
Set xlWb = xlApp.workbooks.Add
Set xlSheet = xlWb.sheets("Sheet1")
xlSheet.Range("A1") = "Name"
xlSheet.Range("B1") = "Email Address"
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)

For Each Item In olFolder.Items
If TypeOf Item Is Outlook.MailItem Then
iLastRow = xlSheet.Range("A" & xlSheet.Rows.Count).End(-4162).Row
xlSheet.Range("A" & iLastRow + 1) = Item.Sender
xlSheet.Range("B" & iLastRow + 1) = Item.SenderEmailAddress
End If
Next Item
lbl_Exit:
Set objNS = Nothing
Set olFolder = Nothing
Set Item = Nothing
Set xlApp = Nothing
Set xlWb = Nothing
Set xlSheet = Nothing
Exit Sub
End Sub