Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 134
  • Last Modified:

Outlook 2013 Exporting Email Addresses

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
BSModlin
Asked:
BSModlin
  • 3
  • 2
2 Solutions
 
akalyan911Commented:
No.. As far i have knowledge..

he can't extract the all contacts of emails at one time..
0
 
Alexei Kuznetsov (Outlook MVP)CEOCommented:
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
 
Nick67Commented:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Nick67Commented:
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
 
Alexei Kuznetsov (Outlook MVP)CEOCommented:
@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
 
Nick67Commented:
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

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now