Solved

Quick way to generate contacts list

Posted on 2007-11-27
30
686 Views
Last Modified: 2010-09-23
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.
0
Comment
Question by:mharcais
  • 11
  • 10
  • 6
  • +3
30 Comments
 
LVL 97

Expert Comment

by:war1
ID: 20358773
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
 
LVL 11

Expert Comment

by:bsharath
ID: 20358947
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
 

Author Comment

by:mharcais
ID: 20359300
Hi bsharath: - I like your solution, cause it looks free! But - how do I save this vbs file???!!!
0
 
LVL 11

Expert Comment

by:bsharath
ID: 20359385
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
 

Author Comment

by:mharcais
ID: 20364378
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
 

Author Comment

by:mharcais
ID: 20364406
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
 
LVL 11

Expert Comment

by:bsharath
ID: 20364415
See your "C:\test1.txt"
0
 
LVL 11

Expert Comment

by:bsharath
ID: 20364439
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
 

Author Comment

by:mharcais
ID: 20364443
HI! Can this be saved in notepad like the last one?
0
 
LVL 11

Expert Comment

by:bsharath
ID: 20364445
I am not sure if the above macro will do what you want...Sorry that as my level of help....
0
 

Author Comment

by:mharcais
ID: 20364480
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
 
LVL 11

Expert Comment

by:bsharath
ID: 20364529
Sorry that's my bit....
Need to wait for another experts comments...
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20367831
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20371767
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20371888
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
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 

Author Comment

by:mharcais
ID: 20380858
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20381373
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20381392
If project explorer not visible try ctrl + R
0
 

Author Comment

by:mharcais
ID: 20382103
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20383472
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20410954
How goes it?
0
 

Author Comment

by:mharcais
ID: 20411027
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20411073
If you have just adjusted the setting then Try restarting outlook.

Chris
0
 

Author Comment

by:mharcais
ID: 20412586
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20413701
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
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 20436625
MHARCAIS

Howgozit?

Chris
0
 

Author Comment

by:mharcais
ID: 20440709
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
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 20440814
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
 

Expert Comment

by:jmengel73
ID: 29217270
Chris, your solution is great. I know this is an old thread, but I just used your macro, and it rocks! Thanks.
0
 

Expert Comment

by:CeriThomas
ID: 33747133
Great solution Chris
0

Featured Post

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

Granting full access permission allows users to access mailboxes present in their database. By giving full access permission one can open and read the content of any mailbox but cannot send emails from that mailbox.
Following basic email etiquette rules will help you write a professional email and achieve a good, lasting impression with your contacts.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now