1. Computer problem? Tech Support Guy is completely free -- paid for by advertisers and donations. Click here to join today! If you're new to Tech Support Guy, we highly recommend that you visit our Guide for New Members.

Export list of all e-mail addresses from Sent folder?

Discussion in 'Business Applications' started by zeloc, Oct 13, 2011.

Thread Status:
Not open for further replies.
  1. zeloc

    zeloc Thread Starter

    Joined:
    Nov 28, 2004
    Messages:
    32
    In Gmail I noticed there is a nice feature whereby I can export a list of names and e-mail addresses of everyone to whom I've ever sent a message (not just My Contacts). Is it possible to do anything like this in Outlook 2007?
     
  2. Rollin_Again

    Rollin_Again

    Joined:
    Sep 4, 2003
    Messages:
    4,912
    You can use a macro to loop through all the messages in your sent items folder and extract the info but this might not work since many people delete their sent items from time to time.

    Rollin
     
  3. Jimmy the Hand

    Jimmy the Hand

    Joined:
    Jul 28, 2006
    Messages:
    1,223
    Try this code. Beforehand, you need to set a reference in the Outlook VB Editor to Microsoft Excel Object Library.
    After starting the macro, select the Sent Items folder in your Outlook.

    The code is not perfect. Sometimes it stops with non-reproducible errors, in spite of the On Error exception handler.
    I couldn't determine the cause. However, if, on error, you click on Debug, then press F5, the code will continue to run, and finish the work eventually. I can't guarantee that all the addresses will be exported, but most of them will.

    Code:
    Sub Export_Adresses()
        Dim appExcel As Excel.Application, wkb As Excel.Workbook, wks As Excel.Worksheet
        Dim rng As Excel.Range
        
        Dim nms As Outlook.NameSpace, fld As Outlook.MAPIFolder, msg As Outlook.MailItem
        Dim rec As Outlook.Recipient
        
        Set nms = Application.GetNamespace("MAPI")
        Set fld = nms.PickFolder
        If fld Is Nothing Then Exit Sub
        
        Set appExcel = New Excel.Application
        appExcel.Visible = True
        Set wkb = appExcel.Workbooks.Add
        Set wks = wkb.Worksheets(1)
        
        appExcel.DisplayAlerts = False
        For Each msg In fld.Items
            On Error GoTo next_message
            For Each rec In msg.Recipients
                wks.Range("A" & wks.Rows.Count).End(xlUp).Offset(1) = rec.Address
            Next
    next_message:
        Next
        appExcel.DisplayAlerts = True
    End Sub
    
    Jimmy
     
As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 733,556 other people just like you!

Thread Status:
Not open for further replies.

Short URL to this thread: https://techguy.org/1022143

  1. This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
    By continuing to use this site, you are consenting to our use of cookies.
    Dismiss Notice