Get email address of all users from all mails in Outlook Folder

re: Get email address of all users from all mails in Outlook Folder

Andreas — Wed, 29 Jul 2009 03:52:01 GMT

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.

re: Get email address of all users from all mails in Outlook Folder

Prasad — Wed, 01 Jul 2009 17:22:52 GMT

Really helpful to get email ids from my outlook out of hundreds of emails that I receive everyday.

Thanks

re: Get email address of all users from all mails in Outlook Folder

Jobe — Mon, 08 Jun 2009 10:19:56 GMT

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!

re: Get email address of all users from all mails in Outlook Folder

Ge — Tue, 12 May 2009 14:05:32 GMT

Please help, it won't work for me. I have outlook 03 and have tried every code to no avail

Got email address of all users from all mails in Outlook Folder!

captain-mruphy — Tue, 10 Feb 2009 18:45:57 GMT

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 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 Documents\MyFile.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

If bRecursive Then

' Might want to compare this to strEmails instead of just appending.

strAll = strAll + GetMessages(objFolder, bRecursive)

End If

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

If bRecursive Then

' Might want to compare this to strEmails instead of just appending.

strEmails = strEmails + getMessageEmails(objFolder, bRecursive)

End If

getMessageEmails = strEmails

End Function

re: Get ALL email address of all users from all mails in Outlook Folder

captain-mruphy — Fri, 06 Feb 2009 21:48:15 GMT

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.

re: Get email address of all users from all mails in Outlook Folder

Colin Charles — Sun, 01 Feb 2009 00:17:21 GMT

How do I change the script to get all the email addresses for the recepients of all the emails I have sent?

re: Get email address of all users from all mails in Outlook Folder

christopher — Fri, 09 Jan 2009 23:05:14 GMT

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??

re: Get email address of all users from all mails in Outlook Folder

Jakob H. Heidelberg — Fri, 09 Jan 2009 09:48:31 GMT

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

Debug.Print strEmails

End Sub

re: Get email address of all users from all mails in Outlook Folder

Mera Hola — Wed, 07 Jan 2009 19:09:30 GMT

This does not work in Outlook 2007. Do you have an updated code for it?

re: Get email address of all users from all mails in Outlook Folder

Dinesh Dhamija — Fri, 18 Aug 2006 18:08:12 GMT

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

re: Get email address of all users from all mails in Outlook Folder

omar — Fri, 18 Aug 2006 03:47:24 GMT

Which line throws the error?

re: Get email address of all users from all mails in Outlook Folder

JJ — Wed, 09 Aug 2006 20:16:17 GMT

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.

re: Get email address of all users from all mails in Outlook Folder

Robert — Wed, 09 Aug 2006 14:44:37 GMT

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