Comments on heidelbergit: Get email address of all users from all mails in a...

Thank you so much for this code!!! In case you wa...

2011-01-26T16:57:13.490+01:00

Thank you so much for this code!!!

In case you want to insert a line break after each e-mail address (instead of the semicolon) - here's the code:

Sub GetEmailAddressesInFolder()
Dim objFolder As MAPIFolder
Dim strEmail As String
Dim strEmails As String
Dim objItem As Object

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 & Chr$(13)
End If
Next
Debug.Print strEmails
End Sub

Problem 2 Sub GetEmailAddressesInFolder() Dim obj...

2009-12-16T00:44:29.345+01:00

Problem 2

Sub GetEmailAddressesInFolder()
Dim objFolder As MAPIFolder
Dim strEmail As String
Dim strSender As String
Dim strEmails As String
Dim objItem As Object
Dim fs, a

Set objFolder = Application.GetNamespace("Mapi").PickFolder

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\temp\testfile.txt", True)

For Each objItem In objFolder.Items
If objItem.Class = olMail Then
strEmail = objItem.SenderEmailAddress
strSender = objItem.SenderName

If InStr(strEmails, strEmail) = 0 Then
a.WriteLine strSender & ", " & strEmail

End If
End If
Next
a.Close
End Sub

Problem 2 Set fs = CreateObject("Scripting.F...

2009-12-16T00:41:30.279+01:00

Problem 2

Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\temp\testfile.txt", True)

For Each objItem In objFolder.Items
If objItem.Class = olMail Then
strEmail = objItem.SenderEmailAddress
strSender = objItem.SenderName

If InStr(strEmails, strEmail) = 0 Then
a.WriteLine strSender & ", " & strEmail

End If
End If
Next
a.Close

Necessity is the mother of invention, I guess. He...

2009-03-06T18:26:00.000+01:00

Necessity is the mother of invention, I guess. Here's what I came up with, and it seems to work well. I didn't solve problem #2, but it's no big deal to copy and paste:

Sub GetEmailAddresses()
Dim objFolder As MAPIFolder
Dim strEmails As String

Set objFolder = Application.GetNamespace("Mapi").PickFolder
strEmails = GetEmailAddressesInFolder(objFolder, "")
Debug.Print strEmails
End Sub

Function GetEmailAddressesInFolder(objFolder As Object, strEmails As String)
Dim strEmail As String
Dim strOutput As String
Dim objItem As Object
Dim objSubFolder As Object

strOutput = strEmails

For Each objSubFolder In objFolder.Folders
strOutput = GetEmailAddressesInFolder(objSubFolder, strOutput)
Next

For Each objItem In objFolder.Items
If objItem.Class = olMail Then
strEmail = objItem.SenderEmailAddress
If InStr(strEmails, strEmail) = 0 Then strOutput = strOutput + ";" + strEmail
End If
Next

GetEmailAddressesInFolder = strOutput
End Function

Hi Mike,

I'd really like to help you out tw...

2009-03-06T03:38:00.000+01:00

Hi Mike,

I'd really like to help you out tweaking the code, but as things look right now I simply don't have the time - very sorry!

If time should arise out of nowhere, I'll post the solutions for your requests here. I can't promise you anything right now.

Best regards
Jakob

This could be just what the doctor ordered for me,...

2009-03-05T22:09:00.000+01:00

This could be just what the doctor ordered for me, but I have two slightly different requirements:

(1) I would love it if I could point to one folder and have it process not only the emails in that folder, but also any subfolders. Can you show me how to tweak the code to do that?

(2) Can the code be tweaked to output to, say, a CSV or text file instead of to the immediate window? Not a huge deal as I can copy and paste, but this would be nice to have as well.

If you would prefer to email me at eglzfan-[AT]-gmail-[DOT]-com, that would also be much appreciated.

Thanks!

Mike Dunham