Sub SendersInFolder()
Dim onsMapi As Outlook.NameSpace
Dim ofolderSource As Outlook.MAPIFolder
Dim omsgItem As Outlook.MailItem
Dim strReport As String
' Get the current Folder
Set onsMapi = Application.GetNamespace("MAPI")
Set ofolderSource = Application.ActiveExplorer.CurrentFolder
' Check for messages in Folder
If ofolderSource.Items.Count = 0 Then
strReport = "No Mail Items in current Folder"
Else
For Each omsgItem In ofolderSource.Items
' Get the Sender's name and Email address
strReport = strReport & omsgItem.SenderName & " / " & GetSenderID(omsgItem) & vbCrLf
Next
End If
MsgBox strReport
' Clean Up
Set ofolderSource = Nothing
Set onsMapi = Nothing
Set omsgItem = Nothing
End Sub