Omar AL Zabir blog on ASP.NET Ajax and .NET 3.5

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

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

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

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

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

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

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

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

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

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

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

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.

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

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

 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

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

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

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

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

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

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.