oulook 2003 get all 'From' and 'To' email addresses

Question

I tried this vba to get all Sender and Recipient email addresses from emails in Outlook 2003 folder

Sub GetALLEmailAddresses()

Dim objFolder As Folder
Set objFolder = Application.ActiveExplorer.Selection

Dim dic As Dictionary
Dim strEmail As String
Dim strEmails As String

Dim objItem As MailItem
For Each objItem In objFolder.Items

    strEmail = objItem.SenderEmailAddress
'If Not dic.Exists(strEmail) Then
'strEmails = strEmails + strEmail + ";"
'dic.Add strEmail, ""
'End If

Next

Debug.Print strEmails
End Sub

any idea what I am doing wrong?

Answer 1

This is my working example for To values

Sub ExtractEmail()
Dim OlApp As Outlook.Application
Dim Mailobject As Object
Dim Email As String
Dim NS As NameSpace
Dim Folder As MAPIFolder
Set OlApp = CreateObject("Outlook.Application")
' Setup Namespace
Set NS = ThisOutlookSession.Session
' Display select folder dialog
Set Folder = NS.PickFolder
' Create Text File
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\email addresses.txt", True)
' loop to read email address from mail items.


Dim dic
Set dic = CreateObject("Scripting.Dictionary")
Dim strEmails As String

For Each Mailobject In Folder.Items
   Email = Mailobject.To

    If InStr(1, Email, "kovalovsky.com", vbTextCompare) Then
        If Not dic.Exists(Email) Then
            strEmails = strEmails + Email + vbCrLf
            dic.Add Email, ""
        End If
    End If
Next

a.WriteLine (strEmails)

Set OlApp = Nothing
Set Mailobject = Nothing
a.Close
End Sub

Answer 2

My code I use in Outlook:

i use it to copy to clipboard but its one email only it doesnt work for whole inbox\folderofchoice

you might be able to create a loop to open your emails get the info then close the email etc etc...

Sub Get_SenderName()

 Dim myItem As Outlook.Inspector
 Dim objItem As Object
 Dim clipboard As MSForms.DataObject

 Set clipboard = New MSForms.DataObject
 Set myItem = Application.ActiveInspector

 If Not TypeName(myItem) = "Nothing" Then

   Set objItem = myItem.CurrentItem
   sSender = objItem.SenderName
   clipboard.SetText sSender
   clipboard.PutInClipboard

 Else
  ErrMsg = MsgBox("No Email Open To Get Data, Please Open Email To Use This.", vbInformation, "You Did It Wrong.")
 End If
End Sub