Emails Addresses to Excel

mkeisha

New Member
Joined
Feb 18, 2009
Messages
12
I have an email that someone forwarded to me and in that forwarded email, there are over 100 email email addresses. (still in the "To:" line of the first email)

I want to get those email addresses plus first and last names into an Excel spreadsheet with 3 columns: email address, first name and last name.

Is there a quick way to do this? The only thing I can think of is to click on each and every email address, add them to my contact list and type in the first and last name and then when that's all done, import my contact list into Excel. However, this is going to be time consuming.

Any help you can offer is greatly appreciated!
Thank you.
Mary Ann
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Derek Brown

Well-known Member
Joined
Dec 26, 2005
Messages
2,390
Have a look at the following.
I am assuming that you are using Outlook.
This works for Outlook 2007 - if you are using an earlier version then you will need to set the reference to the appropriate version (e.g. 11.0 for Outlook 2003).
Code:
Option Explicit
' You must set Tools | References for the following item:
' Microsoft Outlook 12.0 Object LIbrary
Sub Get_Email_Details()
Dim wb As Workbook
Dim ws As Worksheet
Dim lngKount As Long
'
Dim objOutlook As Outlook.Application
Dim objNS As Outlook.Namespace
Dim objFolder1 As Outlook.Folder
Dim objItem As Outlook.MailItem
    '
    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Email Details")
    ws.Activate
    ws.Cells(1, 1) = "Sender"
    ws.Cells(1, 2) = "Sender Email Address"
    ws.Cells(1, 3) = "Creation Time"
    lngKount = 2
    '
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNS = objOutlook.GetNamespace("MAPI")
    Set objFolder1 = objNS.Folders("Personal Folders").Folders("Inbox")
    '
    For Each objItem In objFolder1.Items
 '       If objItem.UnRead = True Then
            If objItem.Class = olmail Then
                With objItem
                    ws.Cells(lngKount, 1) = .SenderName
                    ws.Cells(lngKount, 2) = .SenderEmailAddress
                    ws.Cells(lngKount, 3) = .CreationTime
                    lngKount = lngKount + 1
                End With
            End If
 '       End If
    Next objItem
'
End_Para:
    Set objOutlook = Nothing
    Set objNS = Nothing
    Set objFolder1 = Nothing
    Set objItem = Nothing
    Set ws = Nothing
    Set wb = Nothing
End Sub
Also you may need to change a few things - such as the email folder where I have "Personal Folders" and you will need to add error-trapping.
 
Last edited:

Derek Brown

Well-known Member
Joined
Dec 26, 2005
Messages
2,390
You are welcome.
Perhaps I should have added:
Code:
ws.Cells(lngKount, 4) = .To
However, once you have set the 'reference' to Outlook, you should see the various options once you type the "."
 

Watch MrExcel Video

Forum statistics

Threads
1,113,904
Messages
5,544,978
Members
410,647
Latest member
LegenDSlayeR
Top