Quick way to generate contacts list

HI,

A user is leaving, who has received a huge volume of email, but never built up a contacts list. So all the email addresses are sitting in his inbox in emails. When ever he wanted to email someone, he found their email address from the last one they sent him and clicked reply...

He wants to bring his contacts with him, but obviously wants to avoid having to copy and paste every single email address from his inbox...

Is there a quick way to grab all the email addresses in the inbox, from every address he has ever received an email from out into excel and then sort and delete the duplicates?

I would be most grateful.
mharcaisAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

war1Commented:
Hello mharcais,

There is nothing native to Outlook that will allow you to extract addresses from emails. You can use a third party program like Email Extractor.
http://www.emailaddressmanager.com/outlook/email-extractor.html

Hope this helps!
war1
0
bsharathCommented:
Save this in a vbs file and run...It will get all email id's to a file. Hope this helps...
Dim mailAddr()

Sub AddtoMailArray(addr)
    Dim isFound, arrLen
    isFound = False
    arrLen = getArrLength(mailAddr)
    If arrLen > -1 Then
        For I = 0 To arrLen
            If LCase(addr) = mailAddr(I) Then
                isFound = True
            End If
        Next
    End If
    If isFound = False Then
        ReDim Preserve mailAddr(arrLen + 1)
        mailAddr(arrLen + 1) = LCase(addr)        
    End If
End Sub

Function getArrLength(arr())
    err.clear
    On Error Resume Next    
    getArrLength = UBound(arr)
    if err.number <> 0 then getArrLength = -1
End Function


    Const olFolderSentMail = 5
    Const ForWriting = 2
   
    Dim OutLookApp, fdr, item, re
    Dim cnt
    Dim I
   
    Erase mailAddr
   
    On Error Resume Next
    Set OutLookApp = GetObject(, "Outlook.Application")
    If OutLookApp Is Nothing Then
        Set OutLookApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    Set fdr = OutLookApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
    cnt = 0
    For Each item In fdr.Items
               
        For Each re In item.Recipients
            If I = item.Recipients.Count Then
                  tmp = tmp & re.Address
            Else
                  tmp = tmp & re.Address & ", "
            End If
            AddtoMailArray re.Address            
        Next
        cnt = cnt + 1
        tmp = ""       
    Next
   
    FileName = "C:\test1.txt"
   
    Dim fso, file
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set file = fso.OpenTextFile(FileName, ForWriting, True)
    If getArrLength(mailAddr) > -1 Then
          For I = 0 To UBound(mailAddr)
                   file.Write mailAddr(I) & vbcrlf
        Next
    End If
    file.Close
    set file = nothing
    set fso = nothing
   
    MsgBox "Done!"

Got this from one of my posts in EE>
0
mharcaisAuthor Commented:
Hi bsharath: - I like your solution, cause it looks free! But - how do I save this vbs file???!!!
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

bsharathCommented:
Open a Notepad file > Copy the content into the file and save as Filename.vbs
Run the script when outlook is open.
Then you can see a results file created.
0
mharcaisAuthor Commented:
HI bsharath.I did that, ran it, and Outlook came up with the security warning of another programme trying to access it, which I allowed. It seemed to be working away there for about a minute, but no pop up message at the end, and no test.txt file resulted....

Ideas?
0
mharcaisAuthor Commented:
Apologies, bsharath, it did eventually ... just long after the work appeared to be done in Outlook.

Just a query - it only grabs the email address - any ideas on how to get it to grab first name and last name too?
0
bsharathCommented:
See your "C:\test1.txt"
0
bsharathCommented:
Put this in a outlook macro.
Insert Module and put this code in there and Run....Hope this helps...

Sub ExportContactsToExcel()
    Dim olkContacts As Outlook.MAPIFolder, _
        olkContact As Object, _
        excSheet As Object, _
        intRow As Integer
    Set excApp = CreateObject("Excel.Application")
    Set excBook = excApp.Workbooks.Add()
    Set excSheet = excBook.ActiveSheet
    Set olkContacts = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
    'Write Excel Column Headers
    'Add a line for each contact field to be exported
    excSheet.Cells(1, 1) = "Company Name"
    excSheet.Cells(1, 2) = "Last Name"
    excSheet.Cells(1, 3) = "First Name"
    excSheet.Cells(1, 4) = "Mailing Address"
    intRow = 2
    'Write contacts to spreadsheet
    For Each olkContact In olkContacts.Items
        If olkContact.Class = olContact Then
            'Add a row for each field in Contacts you want to export
            excSheet.Cells(intRow, 1) = olkContact.CompanyName
            excSheet.Cells(intRow, 2) = olkContact.LastName
            excSheet.Cells(intRow, 3) = olkContact.FirstName
            excSheet.Cells(intRow, 4) = olkContact.MailingAddress
            intRow = intRow + 1
        End If
    Next
    Set olkContact = Nothing
    Set olkContacts = Nothing
    'Change the file name and path as desired
    excBook.SaveAs "C:\MyContacts.xls"
    excBook.Close
    Set excSheet = Nothing
    Set excBook = Nothing
    Set excApp = Nothing
    MsgBox "All Done!"
End Sub

0
mharcaisAuthor Commented:
HI! Can this be saved in notepad like the last one?
0
bsharathCommented:
I am not sure if the above macro will do what you want...Sorry that as my level of help....
0
mharcaisAuthor Commented:
HI bsharath, no, that code will only export what is in the contacts folder.

The user has not bothered to set up any contacts - so all the email addresses are just stored within the email addresses in his inbox and sub-folders...
0
bsharathCommented:
Sorry that's my bit....
Need to wait for another experts comments...
0
Chris BottomleySoftware Quality Lead EngineerCommented:
I think this is feasible, dunno at this point an actual solution but i will look into it unless / until you get a suitable solution.

Chris
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Since your user needs to extract data from the email address the available data is limited.  The following VBA script runs in outlook on their pc and extracts the email and associated name into an excel worksheet for sorting.  The operator selects the root folder with emails ... i.e. inbox and then the macro extracts all emails and inserts them into excel.

To launch it run the launchpad macro.

To Create a macro:
------------------

Alt + F11 to open the macro editor
     Insert | Module to insert a code module into the project
     In the project tree select the module.
     Insert the required macro(s) into the selected module, ('Module1' or similar)
Close the Visual Basic Editor.

Check Security as appropriate:
------------------------------

In the application select Tools | Macro | Security
Select Medium
Select OK

To run a macro:
---------------

Alt + F8
Select the macro
Select 'Run'

Chris
Sub launchpad()
 
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
    On Error Resume Next
    
    Set xlApp = Excel.Application
    Set xlBook = xlApp.Workbooks.Add
    Set xlsheet = xlBook.Worksheets(1)
    xlsheet.Range("a1").Activate
    
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set MyFolder = objNS.PickFolder
    Call ProcessFolder(MyFolder, xlsheet)
    xlApp.Visible = True
    
    Set objNS = Nothing
 
Set MyFolder = Nothing
Set xlsheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
 
 
Sub ProcessFolder(StartFolder As MAPIFolder, dataRecord As Excel.Worksheet)
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim mai As mailitem
    On Error Resume Next
    MsgBox StartFolder.Path, , "testing"
    
    ' process all the items in this folder
    For Each objItem In StartFolder.Items
        If TypeName(objItem) = "MailItem" Then
            Set mai = objItem
            dataRecord.Application.ActiveCell.Offset(0, 0) = mai.SenderEmailAddress
            dataRecord.Application.ActiveCell.Offset(0, 1) = mai.SenderName
            dataRecord.Application.ActiveCell.Offset(1, 0).Activate
        End If
    Next
        
    ' process all the subfolders of this folder
    For Each objFolder In StartFolder.Folders
        Call ProcessFolder(objFolder, dataRecord)
    Next
 
Set mai = Nothing
Set objFolder = Nothing
End Sub

Open in new window

0
Chris BottomleySoftware Quality Lead EngineerCommented:
Tarted up to sort the data the following script supercedes that previously posted

Chris
Sub launchpad()
 
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
    On Error Resume Next
    
    Set xlApp = Excel.Application
    Set xlBook = xlApp.Workbooks.Add
    Set xlsheet = xlBook.Worksheets(1)
    xlsheet.Range("A1") = "Sender email Address"
    xlsheet.Range("B1") = "Sender Name"
    xlsheet.Range("a2").Activate
    
    Set olApp = Outlook.Application
    Set objNS = olApp.GetNamespace("MAPI")
    Set MyFolder = objNS.PickFolder
    Call ProcessFolder(MyFolder, xlsheet)
    xlsheet.Select
    xlsheet.Range("A1").Select
    xlsheet.UsedRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    xlsheet.UsedRange.Select
    xlsheet.Application.Selection.Copy
    xlBook.Worksheets(2).Select
    xlsheet.Application.Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        True, Transpose:=False
    xlBook.Worksheets(2).Columns("A:B").Select
    xlsheet.Application.Selection.Columns.AutoFit
    xlsheet.Application.CutCopyMode = False
    xlsheet.Application.Selection.Sort Key1:=Range("B1"), Order1:=xlAscending, Key2:=Range("A1") _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    xlsheet.Application.Range("a1").Activate
    xlApp.Visible = True
    
    Set objNS = Nothing
 
Set MyFolder = Nothing
Set xlsheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
End Sub
 
 
Sub ProcessFolder(StartFolder As MAPIFolder, dataRecord As Excel.Worksheet)
Dim objFolder As Outlook.MAPIFolder
Dim objItem As Object
Dim mai As mailitem
    On Error Resume Next
    MsgBox StartFolder.Path, , "testing"
    
    ' process all the items in this folder
    For Each objItem In StartFolder.Items
        If TypeName(objItem) = "MailItem" Then
            Set mai = objItem
            dataRecord.Application.ActiveCell.Offset(0, 0) = mai.SenderEmailAddress
            dataRecord.Application.ActiveCell.Offset(0, 1) = mai.SenderName
            dataRecord.Application.ActiveCell.Offset(1, 0).Activate
        End If
    Next
        
    ' process all the subfolders of this folder
    For Each objFolder In StartFolder.Folders
        Call ProcessFolder(objFolder, dataRecord)
    Next
 
Set mai = Nothing
Set objFolder = Nothing
End Sub

Open in new window

0
mharcaisAuthor Commented:
Hi chris, many thanks for your assistance.

I haven't actually used a macro in Outlook before, so I've a bit of a prob getting that working, but hopefully you'll be able to assist getting it finished.

Alt + F11 to open the macro editor

Insert | Module to insert a code module into the project
[This opens a window called 'VbaProject.OTM - Module1 (Code)'
On the top there are two drop down menus, on the left is (General) and on the right is (Declarations)]

In the project tree select the module.
[Not sure about this...]

Insert the required macro(s) into the selected module, ('Module1' or similar)
[Am I able to paste the code in, or am I importing a file I've pasted the code into?]

Close the Visual Basic Editor.
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Hi

I haven't actually used a macro in Outlook before, so I've a bit of a prob getting that working, but hopefully you'll be able to assist getting it finished. Indeed.

Alt + F11 to open the macro editor

Insert | Module to insert a code module into the project
[This opens a window called 'VbaProject.OTM - Module1 (Code)'
On the top there are two drop down menus, on the left is (General) and on the right is (Declarations)]
<< Sounds like your in the project area .. which next step takes care of
<< Note the project tree will show a folder 'modules' ... expand this and select the module you inserted a few lines back
In the project tree select the module.
[Not sure about this...]

Insert the required macro(s) into the selected module, ('Module1' or similar)
[Am I able to paste the code in, or am I importing a file I've pasted the code into?]

Close the Visual Basic Editor.
0
Chris BottomleySoftware Quality Lead EngineerCommented:
If project explorer not visible try ctrl + R
0
mharcaisAuthor Commented:
Chris - how do you save the module in the first place (which can then be inserted...)?

Is it saved outside of Outlook in a notepad file? And then imported from the file. Apologies, but this is the step I need a nudge on with...
0
Chris BottomleySoftware Quality Lead EngineerCommented:
In the VBE you should have already inserted a module, insert | module.  i.e. there is no need to create a module in the first place.  The VBE creates a blank one on demand for you to use.  NOte it can be imported but this is an unnecesary step generally.

This inserted module will be blank and displayed in the project explorer, (project\modules\module1 for instance).

Paste the supplied code into that module and then all you need to do is run it.

Chris
0
Chris BottomleySoftware Quality Lead EngineerCommented:
How goes it?
0
mharcaisAuthor Commented:
HI Chris, when I tried to run it I got a "The macros in this project are disabled.Please refer to the online help or documentation of the host application to determine how to enable macros." message, even though I set security to medium as suggested...
0
Chris BottomleySoftware Quality Lead EngineerCommented:
If you have just adjusted the setting then Try restarting outlook.

Chris
0
mharcaisAuthor Commented:
HI Chris. I get this:

Compile error:
User-defined type not defined.

Sub ProcessFolder(StartFolder As MAPIFolder, dataRecord As Excel.Worksheet (is the line highlighted in the code)
0
Chris BottomleySoftware Quality Lead EngineerCommented:
Isn't recognising the excel constants ... go to the VBE screen, (alt f11 if not still open) and select tools : references where you need to select the MS excel object library

Chris
0
Chris BottomleySoftware Quality Lead EngineerCommented:
MHARCAIS

Howgozit?

Chris
0
mharcaisAuthor Commented:
Hi Chris, it ran, but to be honest it didn't bring back anything like the total number of email contacts... it got about 200 in total, but there were many more than that expected... and a few I searched for were not listed... a bit baffling.
0
Chris BottomleySoftware Quality Lead EngineerCommented:
It does delete the duplicates which could explain limited returns and the ones expected maybe have the same email as others recorded. Can you provide (sanitised) exmples of email addresses that are missing?

Chris
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
jmengel73Commented:
Chris, your solution is great. I know this is an old thread, but I just used your macro, and it rocks! Thanks.
0
CeriThomasCommented:
Great solution Chris
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.