Solved

Outlook 2013 Exporting Email Addresses

Posted on 2014-12-09
6
116 Views
Last Modified: 2014-12-13
I have a user connected to Exchange 2013 using Outlook 2013.  He has a folder in Outlook called ABC Emails and he has stored a bunch of emails in there.  He has requested to export or harvest ALL of the email address attached to the emails within that particular folder, OR all email addresses attached to ALL emails within the inbox.  His goal is to gather as may email addresses as possible to export, even if they are not contacts within Outlook.

Can this be done?
0
Comment
Question by:BSModlin
  • 3
  • 2
6 Comments
 
LVL 4

Expert Comment

by:akalyan911
ID: 40489222
No.. As far i have knowledge..

he can't extract the all contacts of emails at one time..
0
 
LVL 13

Assisted Solution

by:Alexei Kuznetsov
Alexei Kuznetsov earned 250 total points
ID: 40490725
This can't be done out of the box. This can be done with either VBA script or third-party utility however. VBA script will be quite complex in this case. This is why I want to recommend the free Save Email Addresses utility. It can extract all email addresses to the specified text file. There are also utilities that can extract addresses to contacts of groups of contacts .

DISCLAIMER: I'm one of the developers of mentioned tools. So feel free to ask any further questions.
0
 
LVL 26

Accepted Solution

by:
Nick67 earned 250 total points
ID: 40492907
It ain't rocket science
This code will grab all the sender addresses from a user-chosen folder if pasted into an Excel code module and run
It puts them all in column A of Sheet 2
it opens Outlook properly and then Raids

Option Explicit
Public wasOpen As Boolean

Function StartApp(ByVal appName) As Object
On Error GoTo ErrorHandler
Dim oApp As Object

wasOpen = True
Set oApp = GetObject(, appName)    'Error here - Run-time error '429':
Set StartApp = oApp

Exit Function

ErrorHandler:
If Err.Number = 429 Then
    'App is not running; open app with CreateObject
    Set oApp = CreateObject(appName)
    wasOpen = False
    Resume Next
Else
    MsgBox Err.Number & " " & Err.Description
End If
End Function

Public Sub Raid()
On Error Resume Next
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objOutlookExplorers As Outlook.Explorers
Dim myitem As Object
Dim ns As Outlook.Namespace
Dim Folder As Outlook.MAPIFolder

Set objOutlook = StartApp("Outlook.Application")
Set ns = objOutlook.GetNamespace("MAPI")
Set Folder = ns.PickFolder
Set objOutlookExplorers = objOutlook.Explorers

If wasOpen = False Then
    objOutlookExplorers.Add Folder
    Folder.Display
    'done opening
End If

Dim x As Long
x = 1
For Each myitem In Folder.Items
    With myitem
        If Len(.SenderEmailAddress) > 0 Then
            Sheets(2).Cells(x, 1).Value = .SenderEmailAddress
            Sheets(2).Cells(x, 2).Value = .CC
            Sheets(2).Cells(x, 3).Value = .BCC
        End If
    End With
    x = x + 1
skip:
Next myitem
    
End Sub

Open in new window

0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 
LVL 26

Expert Comment

by:Nick67
ID: 40492924
But, since CC and BCC return names, not addresses, you'll need this:
Option Explicit
Public wasOpen As Boolean

Function StartApp(ByVal appName) As Object
On Error GoTo ErrorHandler
Dim oApp As Object

wasOpen = True
Set oApp = GetObject(, appName)    'Error here - Run-time error '429':
Set StartApp = oApp

Exit Function

ErrorHandler:
If Err.Number = 429 Then
    'App is not running; open app with CreateObject
    Set oApp = CreateObject(appName)
    wasOpen = False
    Resume Next
Else
    MsgBox Err.Number & " " & Err.Description
End If
End Function

Public Sub Raid()
On Error Resume Next
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objOutlookExplorers As Outlook.Explorers
Dim myitem As Object
Dim ns As Outlook.Namespace
Dim Folder As Outlook.MAPIFolder

Set objOutlook = StartApp("Outlook.Application")
Set ns = objOutlook.GetNamespace("MAPI")
'Set Folder = ns.GetDefaultFolder(olFolderInbox)
Set Folder = ns.PickFolder
Set objOutlookExplorers = objOutlook.Explorers

If wasOpen = False Then
    objOutlookExplorers.Add Folder
    Folder.Display
    'done opening
End If

Dim x As Long
Dim y As Long
x = 1
For Each myitem In Folder.Items
    y = 2
    With myitem
        If Len(.SenderEmailAddress) > 0 Then
            Sheets(2).Cells(x, 1).Value = .SenderEmailAddress
            For Each objOutlookRecip In .Recipients
                Sheets(2).Cells(x, y).Value = objOutlookRecip.Address
                y = y + 1
            Next objOutlookRecip
        End If
    End With
    x = x + 1
skip:
Next myitem
    
End Sub

Open in new window


Senders in A, CC and BCC addresses to the right of that.

When it publishes, an explanation of how to properly open Outlook for automation will be here
http://www.experts-exchange.com/Programming/Microsoft_Development/A_17466-Properly-open-Outlook-as-an-Application-object-in-VBA.html
0
 
LVL 13

Expert Comment

by:Alexei Kuznetsov
ID: 40493478
@Nick67, this will not extract emails from message texts (you need much more code to get the emails from texts). Moreover, Address property is not necessary of SMTP type. Additional steps may be needed to get the correct SMTP address depending on Outlook version.
0
 
LVL 26

Expert Comment

by:Nick67
ID: 40494186
this will not extract emails from message texts (you need much more code to get the emails from texts).
I don't know that my reading of the question implies that the body is to be parsed for vaiid mailto addresses.
Even so, 20 or so lines of code with RegEx parsing for *@*.* with either leading or trailing spaces or semi-colons ought to get that done, if truly desired.

Address property is not necessary of SMTP type.
But those that aren't will be primarily Active Directory addresses -- which will not be required anyway, as Outlook will already have them in a global address list.

Additional steps may be needed to get the correct SMTP address depending on Outlook version.
I am working with O2003, which is already out of support, and the code works fine.  I doubt that support for earlier versions than that will be required. (Outlook 2013 is referenced in the question title)
0

Featured Post

Shouldn't all users have the same email signature?

You wouldn't let your users design their own business cards, would you? So, why do you let them design their own email signatures? Think of the damage they could be doing to your brand reputation! Choose the easy way to manage set up and add email signatures for all users.

Join & Write a Comment

Sometimes Outlook might have problems sending a message. There may be various causes- corrupted PST, AV scanner etc. The message, instead of going to the Sent Items folder, sits in the Outbox indefinitely. To remove it you can use a free tool cal…
Scam emails are a huge burden for many businesses. Spotting one is not always easy. Follow our tips to identify if an email you receive is a scam.
To show how to generate a certificate request in Exchange 2013. We show this process by using the Exchange Admin Center. Log into Exchange Admin Center.:  First we need to log into the Exchange Admin Center. Navigate to the Servers >> Certificates…
In this Micro Video tutorial you will learn the basics about Database Availability Groups and How to configure one using a live Exchange Server Environment. The video tutorial explains the basics of the Exchange server Database Availability grou…

708 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

15 Experts available now in Live!

Get 1:1 Help Now