Vba – extract email address from outlook

outlookvba

I am trying to extract email addresses of all emails in my Outlook inbox. I found this code on the Internet.

Sub GetALLEmailAddresses()

Dim objFolder As MAPIFolder
Dim strEmail As String
Dim strEmails As String
''' Requires reference to Microsoft Scripting Runtime
Dim dic As New Dictionary
Dim objItem As Object

''Set objFolder = Application.ActiveExplorer.Selection
Set objFolder = Application.GetNamespace("Mapi").PickFolder

For Each objItem In objFolder.Items

   If objItem.Class = olMail Then

       strEmail = objItem.SenderEmailAddress

       If Not dic.Exists(strEmail) Then

           strEmails = strEmails + strEmail + vbCrLf

           dic.Add strEmail, ""

       End If

I am using outlook 2007. When I run this code from the Outlook Visual Basic Editor with F5 I get an error on the following line.

Dim dic As New Dictionary

"user defined type not defined"

Best Answer

I have provided updated code below

  1. to dump the Inbox email addresses to a CSV file "c:\emails.csv" (the current code provides no "outlook" for the collected addresses
  2. the code above works on a selected folder rather than Inbox as per your request

[Update: For clarity this is your old code that uses "early binding", setting this reference is unnecessary for my updated code below which uses "late binding"]

Part A: Your existing code (early binding)

In terms of the error you received:

The code sample aboves uses early binding, this comment "Requires reference to Microsoft Scripting Runtime" indciates that you need to set the reference

  • Goto the Tools menu
  • Select 'References'
  • check "Microdoft Scripting Runtime"

enter image description here Part B: My new code (late binding - setting the reference is unnecessary)

Working Code 

Sub GetALLEmailAddresses() 
Dim objFolder As MAPIFolder
Dim strEmail As String
Dim strEmails As String
Dim objDic As Object
Dim objItem As Object
Dim objFSO As Object
Dim objTF As Object

Set objDic = CreateObject("scripting.dictionary")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objTF = objFSO.createtextfile("C:\emails.csv", 2)
Set objFolder = Application.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
For Each objItem In objFolder.Items
    If objItem.Class = olMail Then
        strEmail = objItem.SenderEmailAddress
        If Not objDic.Exists(strEmail) Then
            objTF.writeline strEmail
            objDic.Add strEmail, ""
        End If
    End If
Next
objTF.Close
End Sub
Related Topic