Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How do you extract email addresses from the 'To' field in outlook?

I have been using VBA to some degree, using this code:

Sub ExtractEmail()
Dim OlApp As Outlook.Application
Dim Mailobject As Object
Dim Email As String
Dim NS As NameSpace
Dim Folder As MAPIFolder
Set OlApp = CreateObject("Outlook.Application")
' Setup Namespace
Set NS = ThisOutlookSession.Session
' Display select folder dialog
Set Folder = NS.PickFolder
' Create Text File
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.CreateTextFile("c:\mydocuments\emailss.txt", True)
' loop to read email address from mail items.
For Each Mailobject In Folder.Items
   Email = Mailobject.To
   a.WriteLine (Email)
Next
Set OlApp = Nothing
Set Mailobject = Nothing
a.Close
End Sub

However this gives output as the names of the email addresses and not the actual email address with the "[email protected]".

Is there an attributte of the mailobject that will allow the email addresses and not the names to be written from the 'To' Textbox.

Thanks

like image 286
tread Avatar asked Sep 28 '12 14:09

tread


People also ask

What is the easiest way to extract email addresses from Outlook?

In the Outlook Options box, choose Advanced. Under the Export section, choose Export. In the Import and Export Wizard, select Export to a file, and then choose Next. Under Create a file of type, choose the type of export that you want.

How can I Export all email addresses I have sent to from Outlook?

To do this, you simply log in to your Outlook account and click on “File.” In the dropdown menu, select “Import and Export.” A dialogue box will pop up with some options—click on “Export to File,” then “Next.” The next step will be to select the file type you want to save your downloaded email list as.


1 Answers

Another code alternative (based initially on the answer by @andreasDL) which should be able to be used...

Pass in a MailItem to the EmailAddressInfo function to get an array of the Sender, To and CC fields from the message

Private Const olOriginator As Long = 0, olTo As Long = 1, olCC As Long = 2, olBCC As Long = 3
'BCC addresses are not included within received messages

Function PrintEmailAddresses(olItem As MailItem)
    If olItem.Class <> olMail Then Exit Function
    
    Dim Arr As Variant: Arr = EmailAddressInfo(olItem)
    Debug.Print "Sender: " & Arr(olOriginator)
    Debug.Print "To Address: " & Arr(olTo)
    Debug.Print "CC Address: " & Arr(olCC)
End Function

Private Function EmailAddressInfo(olItem As MailItem) As Variant
    If olItem.Class <> olMail Then Exit Function
    
On Error GoTo ExitFunction
    
    Dim olRecipient As Outlook.Recipient
    Dim olEU As Outlook.ExchangeUser
    Dim olEDL As Outlook.ExchangeDistributionList
    Dim ToAddress, CCAddress, Originator, email As String
            
    With olItem
        Select Case UCase(.SenderEmailType)
            Case "SMTP": Originator = .SenderEmailAddress
            Case Else
                Set olEU = .Sender.GetExchangeUser
                If Not olEU Is Nothing Then Originator = olEU.PrimarySmtpAddress
        End Select
    End With
    
    For Each olRecipient In olItem.Recipients
       With olRecipient
            Select Case .AddressEntry.AddressEntryUserType
                Case olSmtpAddressEntry 'OlAddressEntryUserType.
                    email = .Address
                Case olExchangeDistributionListAddressEntry, olOutlookDistributionListAddressEntry
                    Set olEDL = .AddressEntry.GetExchangeDistributionList
                    email = IIf(Not olEDL Is Nothing, olEDL.PrimarySmtpAddress, "")
                Case Else
                    Set olEU = .AddressEntry.GetExchangeUser
                    email = IIf(Not olEU Is Nothing, olEU.PrimarySmtpAddress, "")
            End Select
            If email <> "" Then
                Select Case .Type
                    Case olTo: ToAddress = ToAddress & email & ";"
                    Case olCC: CCAddress = CCAddress & email & ";"
                End Select
            End If
        End With
    Next
    EmailAddressInfo = Array(Originator, ToAddress, CCAddress)
ExitFunction:
End Function
like image 110
Tragamor Avatar answered Nov 10 '22 11:11

Tragamor