Solved

outlook 2007 extract email addresses

Posted on 2009-04-14
5
990 Views
Last Modified: 2013-11-27
I have created and tried a couple of different macros I saw some users at EE suggest, but i have not had any success.  We have an old mailing list that needs to be updated I would like to extract the email addresses from all of our undeliverables.

all emails are from: System Administrator
and I would like to recover the "To" field.

Any ideas?
0
Comment
Question by:bingboo
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 74

Assisted Solution

by:Jeffrey Coachman
Jeffrey Coachman earned 20 total points
ID: 24142560
bingboo,

I will presume that:
1. This is a table
2. "System Administrator" is a Field in that table
3. This is a one shot deal

Run this query to update the "To" field with the values from the "System Administrator" field.
  UPDATE YourTable SET YourTable.[To] = [System Administrator]

Run this query if you want to delete the values from the System Administrator" field, after they are copied to the "To" field.
  UPDATE YourTable SET YourTable.[System Administrator] = "" 
  WHERE YourTable.[System Administrator] Is Not Null

JeffCoachman
0
 
LVL 65

Assisted Solution

by:rockiroads
rockiroads earned 20 total points
ID: 24145303
You could try iterate thru items (tested on outlook 2003, would assume it still works on outlook 2007)

    Dim olApp As Object
    Dim olFolder As Object
    Dim i As Integer
   
   
    Set olApp = CreateObject("Outlook.Application")
    Set olFolder = olApp.GetNamespace("MAPI").GetDefaultFolder(6)
    For i = 1 To olFolder.items.count

'TWO WAYS TO CHECK - EITHER CHECK NAME OR ADDRESS

'1) NAME
        If InStr(1, LCase$(olFolder.items(i).SenderName), "System Administrator") > 0 Then

'2) EMAIL ADDY
        If InStr(1, LCase$(olFolder.items(i).SenderEmailAddress), "aa@bb") > 0 Then

            'Dump the to address
            Debug.Print olFolder.items(i).To
        End If
    Next i
   
    Set olFolder = Nothing
    Set olApp = Nothing

0
 

Author Comment

by:bingboo
ID: 24147902
The emails are currently in a subfolder under the inbox.  The script I have so far allows me to launch and then specify directory location, it then open excels but it is empty (from what I read it is confirmed success on 2003).



Option Explicit
 
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 = CreateObject("Excel.Application")
    Set xlbook = xlApp.Workbooks.Add
    Set xlsheet = xlbook.Worksheets(1)
    xlsheet.Range("A1") = "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:A").Select
    xlsheet.Application.Selection.Columns.AutoFit
    xlsheet.Application.CutCopyMode = False
    xlbook.Worksheets(2).UsedRange.Select
    xlsheet.Application.Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    xlsheet.Select
    xlsheet.ShowAllData
    xlsheet.Range("a1").Select
    xlbook.Worksheets(2).Select
    xlbook.Worksheets(2).Range("A1").Select
    xlApp.Visible = True
    
    Set objNS = Nothing
 
Set MyFolder = Nothing
Set xlsheet = Nothing
Set xlbook = Nothing
Set xlApp = Nothing
End Sub
Function fnEmailVal(mailAddress As String) As Boolean
' Uses "Microsoft VBScript Regular Expressions" Type Library
Dim regEx As RegExp
    
    Set regEx = New RegExp
    regEx.Pattern = "^\w+([\.-]?\w+)*@\w+([\.-]?\w+)*(\.\w{2,3})+$"
    fnEmailVal = regEx.Test(mailAddress) = True
    
Set regEx = Nothing
End Function
 
Sub ProcessFolder(startFolder As MAPIFolder, dataRecord As Excel.Worksheet)
Dim objFolder As Outlook.MAPIFolder
Dim objitem As Object
Dim mai As MailItem
Dim rejects() As String
Dim addy_count As Integer
Dim strBody As String
Dim emailInvest As String
 
    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
            If mai.BodyFormat = olFormatHTML Then
            ElseIf mai.BodyFormat = olFormatPlain Or mai.BodyFormat = olFormatRichText Then
                mai.Body = Replace(mai.Body, "<", " ")
                mai.Body = Replace(mai.Body, ">", " ")
                mai.Body = Replace(mai.Body, "[", " ")
                mai.Body = Replace(mai.Body, "]", " ")
                mai.Body = Replace(mai.Body, "mailto:", " ")
                mai.Body = Replace(mai.Body, "/t", " ")
                mai.Body = Replace(mai.Body, Chr(10), " ")
                mai.Body = Replace(mai.Body, Chr(13), " ")
                mai.Body = Replace(mai.Body, vbCrLf, " ")
                rejects = Split(mai.Body & "@", "@")
                If UBound(rejects) > 1 Then
                    For addy_count = 1 To UBound(rejects) - 1
                        emailInvest = Right(rejects(addy_count), Len(rejects(addy_count)) - InStrRev(rejects(addy_count), " ")) & "@"
                        emailInvest = Trim(emailInvest & Left(rejects(addy_count + 1), InStr(rejects(addy_count + 1), " ")))
                        If fnEmailVal(emailInvest) Then
                        'Debug.Print emailInvest
                            dataRecord.Application.ActiveCell.Offset(0, 0) = emailInvest
                            dataRecord.Application.ActiveCell.Offset(1, 0).Activate
                        End If
                    Next
                End If
            End If
        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
 

Accepted Solution

by:
bingboo earned 0 total points
ID: 24296422
Anyone that needs this done --- this worked flawlessly and a very simple solution:
In Outlook 2007, click on File, Import and Export and the Wizard opens up.
Select the option to Export to a File and click on Next
Select Microsoft Excel 97-2003 (or a CSV file) and click on Next
Select the folder that your sales inquiries reside in and click on Next
Click on Browse to select a location and then type the file name that you want to export the information to and then click on Next
Here is the important bit - click on Map Custom Fields. This will bring up a list of all the available fields that are available in that folder.
Since we are only interested in Email address, click on Clear Map and then from the Left side click on From: (address) and drag that to the Right list
Click on OK
Click on Finish
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
ID: 24343962
bingboo,

;-)

Well it was not clear that you simply wanted this.
You never clarified any of the presumptions in my original post.

Please remember that you did not state if this was an Outlook table or an externally generated table.

But, in any event, I am glad you got the issue resolved.
;-)

JeffCoachman
0

Featured Post

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you have clients or friends from around the world, it becomes a challenge to arrange a meeting or effectively manage your time. This is where Outlook's capability to show 2 time zones in one calendar comes in handy.
In earlier versions of Windows (XP and before), you could drag a database to the taskbar, where it would appear as a taskbar icon to open that database.  This article shows how to recreate this functionality in Windows 7 through 10.
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
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 …

726 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