Sometimes you want to send some important notice to everyone who
has ever mailed you. Let’s say you have a folder named “Friends” in
Outlook where you store all the emails from your friends. Now you
want to get all of their email addresses. Pretty difficult work if
you have thousands of such mails. Here’s an easy way.
- Select the folder in Outlook and press ALT+F11. It will open
Visual Basic Editor. - Double click on ThisOutlookSession from the Project tree.
- Paste the following function:
Sub GetALLEmailAddresses()
Dim objFolder As Folder
Set objFolder = Application.ActiveExplorer.Selection
Dim dic As New 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
Hit F5 and it will run for a while. Then press Ctrl+G. You will
see the email addresses in the “Immediate
Window”.
Copy the whole string and you have all the email addresses from
all the emails in the selected Outlook folder. There will be no
duplicate address in the list.
More better…
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 + “;”
dic.Add strEmail, “”
End If
End If
Next
Debug.Print strEmails
End Sub
Hey what do I need installed for the script to run? I’m getting a ‘user-defined type not defined’ compile error on the Folder type. I have the Office 2003 Resource Kit and .NET Programmability Support / VB Scripting Support features installed for Outlook.
Which line throws the error?
First of all, I like your blogs.
Secondly, The code you gave did not work for me, So I chnaged the code a little to make it work.
Here is the updated code.
Sub GetALLEmailAddresses()
Dim objExplorer As Explorer
Set objExplorer = Application.ActiveExplorer()
Dim objFolder As MAPIFolder
Set objFolder = objExplorer.CurrentFolder
Dim dic As New 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
This does not work in Outlook 2007. Do you have an updated code for it?
Hi, try this code instead (simple version, without the dictionary object)
Sub GetALLEmailAddresses()
Dim objFolder As MAPIFolder
Dim strEmail As String
Dim strEmails As String
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 InStr(strEmails, strEmail) = 0 Then strEmails = strEmails + strEmail + “;”
End If
Next
Debug.Print strEmails
End Sub
hey the last script from Jacob worked for me great-
how would I change this to grab the CC: addresses as well as the sender addresses??
How do I change the script to get all the email addresses for the recepients of all the emails I have sent?
This code is so close to exactly what I needed and I thank you guys a lot for putting it together.
However I was wondering if someone could write a few lines into it that would let you select the top folder, and have it recurse down through ever folder nested under that.
Okay guys, I worked on this for a little while and it finnaly works, abate messyness. I found a module to print this to a text file and two moduels for the recursive function: one takes names, e-mail, and subject from each e-mail and makes a list that is pastable into excel. The other makes a list of every e-mail with no duplicates. Choose the one you want call.
'This is the main Sub, It picks the folder and calls the functions to recurse and save
Sub GetALLEmailAddresses()
Dim objFolder1 As MAPIFolder
Dim strEmail1 As String
Dim strEmails1 As String
Dim objItem As Object
Dim writeText As Boolean
Set objFolder1 = Application.GetNamespace(“Mapi”).PickFolder
strEmails1 = GetMessages(objFolder1, True)
'strEmails1 = GetMessageEmails(objFolder1, True)
Debug.Print strEmails1
writeText = SaveTextToFile(“C:file.txt”, strEmails1, True)
End Sub
'this is verbatem from http://www.freevbcode.com/ShowCode.Asp, it saves the files to a text file
Public Function SaveTextToFile(FileFullPath As String, _
sText As String, Optional Overwrite As Boolean = False) As _
Boolean
'Purpose: Save Text to a file
'Parameters:
'– FileFullPath – Directory/FileName to save file to
'– sText – Text to write to file
'– Overwrite (optional): If true, if the file exists, it
'is overwritten. If false,
'contents are appended to file
'if the file exists
'Returns: True if successful, false otherwise
'Example:
'SaveTextToFile “C:My DocumentsMyFile.txt”, “Hello There”
On Error GoTo ErrorHandler
Dim iFileNumber As Integer
iFileNumber = FreeFile
If Overwrite Then
Open FileFullPath For Output As #iFileNumber
Else
Open FileFullPath For Append As #iFileNumber
End If
Print #iFileNumber, sText
SaveTextToFile = True
ErrorHandler:
Close #iFileNumber
End Function
'This is the GetMessages that takes a folder and returns a list of the “name, e=mail, subject”s
Public Function GetMessages(oFolder As MAPIFolder, ByVal bRecursive As Boolean) As String
Dim objFolder As Outlook.MAPIFolder
Dim strEmail As String
Dim strEmails As String
Dim strName As String
Dim strSubject As String
Dim strAll As String
Dim strItemAll As String
Dim objItem As Object
Dim objFolders As Outlook.Folders
Set objFolders = oFolder.Folders
For Each objFolder In objFolders
For Each objItem In objFolder.Items
If objItem.Class = olMail Then
strEmail = objItem.SenderEmailAddress
strName = objItem.SenderName
strSubject = objItem.Subject
strItemAll = strName + “,” + strEmail + “,” + strSubject
'If InStr(strEmails, strEmail) = 0 Then strEmails = strEmails + strEmail + “;”
strAll = strAll & Chr(13) & strItemAll
End If
Next
If bRecursive Then
' Might want to compare this to strEmails instead of just appending.
strAll = strAll + GetMessages(objFolder, bRecursive)
End If
Next
GetMessages = strAll
End Function
'This is the the function that returns a list of “;” delimited e-mails with no duplicates.
Public Function getMessageEmails(oFolder As MAPIFolder, ByVal bRecursive As Boolean) As String
Dim objFolder As Outlook.MAPIFolder
Dim strEmail As String
Dim strEmails As String
Dim objItem As Object
Dim objFolders As Outlook.Folders
Set objFolders = oFolder.Folders
For Each objFolder In objFolders
For Each objItem In objFolder.Items
If objItem.Class = olMail Then
strEmail = objItem.SenderEmailAddress
If InStr(strEmails, strEmail) = 0 Then strEmails = strEmails + strEmail + “;”
End If
Next
If bRecursive Then
' Might want to compare this to strEmails instead of just appending.
strEmails = strEmails + getMessageEmails(objFolder, bRecursive)
End If
Next
getMessageEmails = strEmails
End Function
Please help, it won't work for me. I have outlook 03 and have tried every code to no avail
Jakob's simple version worked perfectly for me in outlook 2007. all other versions with the dictionary object displayed an error. Now to try to get 400 emails into csv format…
THANKS!
Really helpful to get email ids from my outlook out of hundreds of emails that I receive everyday.
Thanks
Hello guys, can you modify Jakobs version for me so I can get all email addresses within the email bodies instead of the the “From” field in a selected folder?
I have saved all bounced back emails in a separate folder and want to get now the email addresses that bounced back to clean the OK list.
I have a very simple solution. Download NK2VIEW from the below link. NK2VIEW will display all email ids to which you have ever sent an email to. Excellent small utility
http://www.nirsoft.net/utils/outlook_nk2_autocomplete.html
Omar al Zabir… Salaam and Thank you very much. You’re the man, and then all those that have added tweaks… errr.. you’re the people.
I’ve been wanting this kind of feature for ages and I have been building a folder called “make email list” hoping that one day I will find an easy way to do it… and you’ve shown me. I’m using Outlook 2010 so I hope it works. I will try in a few days.
Then I can notify all my contacts about my new website!
All i need now, is work out how to not get caught up in the SPAM mess if I’m going to be sending the email to the 100’s or maybe 000s of email addresses I expect to have on the list! That obviously wont help my rankings!
I’m using 2007 and I getting run time errors. What should I do?
This is genius stuff, great work!
Anyone get this to work for Outlook 2007 or Outlook 2010??
Hi all…
Omar tx for the Idea… I took your code and rewrite it a bit so it extract email from subfolders to
NOTE: Guys if you copy paste the code you have to change the quetes because of the wrong font and you have to add reference to Microsoft Scripting Runtime: Tools –> References –> check “Microsoft Scripting Runtime”
regards
Sub EmailExport()
‘Requires reference to Microsoft Scripting Runtime
‘Tools –> References –> check “Microsoft Scripting Runtime”
Dim outApp As New Outlook.Application
Dim mpf As Outlook.MAPIFolder
Dim mpfSubFolder As Outlook.MAPIFolder
Dim mpfSubFolder1 As Outlook.MAPIFolder
Dim flds As Outlook.Folders
Dim flds1 As Outlook.Folders
Dim idx As Integer
Dim strEmail As String
Dim strEmails As String
Dim strCC As String
Dim strCCs As String
Dim dic As New Dictionary
Dim i As Integer
i = 1
Set mpf = Application.GetNamespace(“Mapi”).PickFolder
Set flds = mpf.Folders
Set mpfSubFolder = flds.GetFirst
Do While Not mpfSubFolder Is Nothing
Debug.Print i & “-” & mpfSubFolder
For Each objItem In mpfSubFolder.Items
If objItem.Class = olMail Then
strEmail = objItem.SenderEmailAddress
strCC = objItem.cc
If Not dic.Exists(strEmail) Then
strEmails = strEmails + strEmail + vbCrLf
strCCs = strCCs + strCC + vbCrLf
End If
End If
Next
Set flds1 = mpfSubFolder.Folders
Set mpfSubFolder1 = flds1.GetFirst
Do While Not mpfSubFolder1 Is Nothing
Debug.Print i & “-” & mpfSubFolder1
For Each objItem1 In mpfSubFolder1.Items
If objItem1.Class = olMail Then
strEmail = objItem1.SenderEmailAddress
strCC = objItem1.cc
If Not dic.Exists(strEmail) Then
strEmails = strEmails + strEmail + vbCrLf
strCCs = strCCs + strCC + “;”
End If
End If
Next
Set mpfSubFolder1 = flds1.GetNext
i = i + 1
Loop
Set mpfSubFolder = flds.GetNext
i = i + 1
Loop
writeText = SaveTextToFile(“C:file.txt”, strEmails, True)
writeText = SaveTextToFile(“C:fileCC.txt”, strCCs, True)
dic.Add strEmail, “”
End Sub
‘this is verbatem from http://www.freevbcode.com/ShowCode.Asp, it saves the files to a text file
Public Function SaveTextToFile(FileFullPath As String, sText As String, Optional Overwrite As Boolean = False) As Boolean
‘Purpose: Save Text to a file
‘Parameters:
‘– FileFullPath – Directory/FileName to save file to
‘– sText – Text to write to file
‘– Overwrite (optional): If true, if the file exists, it
‘is overwritten. If false,
‘contents are appended to file
‘if the file exists
‘Returns: True if successful, false otherwise
‘Example:
‘SaveTextToFile “C:My DocumentsMyFile.txt”, “Hello There”
On Error GoTo ErrorHandler
Dim iFileNumber As Integer
iFileNumber = FreeFile
If Overwrite Then
Open FileFullPath For Output As #iFileNumber
Else
Open FileFullPath For Append As #iFileNumber
End If
Print #iFileNumber, sText
SaveTextToFile = True
ErrorHandler:
Close #iFileNumber
End Function
@Bujez: what version of Outlook does your code work for?
AAARGH… Outlook 2007.
I keep getting “One or more parameter values are not valid”. I am currently trying to use Bujez’s code. I have copied and pasted exactly, enabled Microsoft Scripting Runtime and changed the quote marks (“).
What do I do? I have tried previously Omars code and the others.
ok, sorry guys… i missed the odd quaotation marks (“) that had to be changed. It works. Thanks! Brilliant. Now if only it can go through the body of emails too… cant please some people eh?!
Ha! Finally got it working with the simple, unfortunately i cant see by whom the post was made.
And i’m just an end-user so you can imagine the hours you guys saved.
Thanks!!!!!!!
Really useful script , had issues getting it to work because of the wierd formating changes through wordpress , but found working code here
http://geekswithblogs.net/VROD/archive/2008/11/08/126878.aspx
And works with outlook 2010 , Thnaks
how to extract email id’s of friends in facebook using GWT in eclipse?
Please help me out…..
According to my system, your little bit of code to extract the email addresses from Outlook doesn’t work! error; “user -defined type not defined (Dim dic As New Dictionary)……
John
When I ran the simple (without Dic) version, it gave me a run time error that says –
Run-time Error ‘-2147024809 (80070057)
Could not complete the operation. One or more parameter values are not valid.
Can somebody please help.
Ashish and others — this runtime error is likely due to the way you might copy/paste from a web browser into the VB editor. The VB editor accepts the special characters like slanted double-quotes and single-quotes, so they are not valid.
You need to go to all double-quotes and single-quotes in the code and replace them with proper double and single quotes.
Hello,
I am using Microsoft Outlook 2007, I have tried to copy paste all options suggested above but none is worked for me as it show always error message while giving F5, can any one help me to run it successfully.
It would be great help,
My email id is educationworld@gmail.com
Also guide me how to follow this blog as I did try to check where I can register my email id but could not find any details.
Prasanna Acharya
hello
Do you know please how we can get lists of all users’ contacts lists from Outlook/exchange, what is the best way?
Thanks
mali
Hello Guys,
I am using outlook 2010 professional 64bit, can anybody help me out to get the email ids from my outlook, I have more than 1lakh email in my inbox. So, it would be really helpful for me if you provide me the solution.
Thank you,
Regards,
Vijay
I appreciate the Paris Wells post on 26 May 2011 at 22:11. http://geekswithblogs.net/VROD/archive/2008/11/08/126878.aspx. it works for me in outlook 2007. can anyone help me. how to retrieve bcc & cc address
I ran the script below on a folder that contains 2000 emails. I’m doing this on outlook 2007.
But it only retrieved about 40 addresses. Now each of the 2000 emails goes to a different person, no duplicates.
any thought why if only grabs 40 addresses?
Thanks
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
End If
Next
Debug.Print strEmails
End Sub
I tried all te posibilities but it doesn’t work in Outlook 2007.
got a syntax fault:
If InStr(strEmails, strEmail) = 0 Then strEmails = strEmails + strEmail + “;”
Isnt this function the same as using Import export in outlook where you can extract all the email ids from each folder ?