none
Distribution List Save As .txt using VBA in Outlook 2003

    Question

  • I have several distribution lists, and each month I open each of them and save them as a .txt file, then open them in an Excel worksheet and compare them to the list in Excel.  I have never used VBA in Outlook 2003, which unfortunately doesn't have a "record macro" option.  I would like to create a macro that opens each list and saves it as a .txt file.  For instance, the distribution list names are List1, List2, etc.

    Thanks for any help that can be provided!


    taxgirl
    Sunday, October 31, 2010 8:31 PM

All replies

  • It's been 6 months.   Do you still need an answer for this?

     

    Tuesday, March 29, 2011 7:36 PM
  • Well, I'm still doing this manually, so sure - I'd love an answer!
    taxgirl
    Tuesday, March 29, 2011 7:54 PM
  • Oh - one change - I'm now using Outlook 2010.
    taxgirl
    • Proposed as answer by dmeller69 Thursday, March 31, 2011 2:13 AM
    • Unproposed as answer by dmeller69 Thursday, March 31, 2011 2:13 AM
    Tuesday, March 29, 2011 7:54 PM
  • sorry.  clicked the wrong choice

    I have an Excel 2003 workbook that I use to send email to each member of various distr lists.  The code works its way thru the Outlook Object Model to extract the members of each list.  Would that be enough?  Can you modify it for your own use?

    Or I could code something unique for you.

     

    How do we get out of the forum and talk directly?

    Thursday, March 31, 2011 2:16 AM
  • This does sound like something I may be able to adapt for my use.  However, I prefer to communicate only through the forum for 2 reasons - 1) privacy, and 2) all forum answers remain available for the use of others who may need them.
    taxgirl
    Thursday, March 31, 2011 3:27 AM
  • Is there a way to attach an Excel workbook, or do I have to send the source code as text

    (Sorry.. I'm new to forums)

    Saturday, April 02, 2011 2:21 AM
  • The following code in a Word Macro will populate a Word document with data from the Outlook Contacts
       Dim ol As Object
      Dim olns As Object
      Dim objFolder As Object
      Dim objAllContacts As Object
      Dim Contact As Object
      ' Set the Application object.
      Set ol = CreateObject("Outlook.Application")
      ' Set the Namespace object.
      Set olns = ol.GetNamespace("MAPI")
      ' Set the default Contacts folder.
      Set objFolder = olns.GetDefaultFolder(10)
      ' Set objAllContacts equal to the collection of all contacts.
      Set objAllContacts = objFolder.Items
      ' Loop through each contact.
      For Each Contact In objAllContacts
         ' Insert the data into the active document
         ActiveDocument.Range.InsertAfter Contact.FullName & vbCr & Contact.BusinessAddress & vbCr & vbCr
      Next

    It uses Late Binding so it is independent of the version of Outlook


    Hope this helps.

    Doug Robbins - Word MVP,
    dkr[atsymbol]mvps[dot]org
    Posted via the Community Bridge

    "taxgirl" wrote in message news:7aa28b2f-38d4-48c1-bed6-37e7afc47604@communitybridge.codeplex.com...

    This does sound like something I may be able to adapt for my use. However, I prefer to communicate only through the forum for 2 reasons - 1) privacy, and 2) all forum answers remain available for the use of others who may need them.


    taxgirl


    Doug Robbins - Word MVP dkr[atsymbol]mvps[dot]org
    Saturday, April 02, 2011 9:54 AM
  • I wish I could just send you the workbook, but...

    ______________________________________________________
    Sheet1 should look something like this:

    Enter the Group Names below, then click  [Go]  <-- this is a button named cbGo

    Group Name  <-- this cell is named "Group_Name_hdr"

      <-- start entering group names here in cell A3

    ______________________________________________________
    The code for Sheet1 is:

    Private Sub cbGo_Click()
    Dim objOutlook As New Outlook.Application
    Dim objNamespace As Namespace
    Dim objAddressList As AddressList
    Dim objAddressEntry As AddressEntry
    Dim wListName As String
    Dim wColorIndex
    Dim wGroupColorIndex
    Dim wGroupRow As Long
    
    Set objOutlook = New Outlook.Application
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objAddressList = objNamespace.AddressLists("Global Address List")
    
      wRow = Range("Group_Name_hdr").Row + 1
      wOutRow = Sheet2.Range("Output_hdrs").Row + Sheet2.Range("Output_hdrs").Rows.Count
      wLastRow = Sheet2.Range("A1").SpecialCells(xlCellTypeLastCell).Row
      If wLastRow >= wOutRow Then
        Sheet2.Range( _
              Sheet2.Cells(wOutRow, 1), _
              Sheet2.Cells(wLastRow, 1) _
              ).EntireRow.Delete
      End If
      
      Do While Not IsEmpty(Cells(wRow, 1))
      
        Cells(wRow, 1).Select
        wListName = Cells(wRow, 1)
        
        With Sheet2.Cells(wOutRow, 1)
          .Formula = wListName
          .Font.Bold = True
        End With
        wGroupRow = wOutRow
        wGroupColorIndex = 54
        wOutRow = wOutRow + 1
        
        Set objAddressEntry = objAddressList.AddressEntries(wListName)
        If objAddressEntry <> wListName Then
          Sheet2.Cells(wOutRow, 2) = "-does not exist-"
          Sheet2.Cells(wOutRow, 2).Font.ColorIndex = 3
          wOutRow = wOutRow + 1
        Else
          If objAddressEntry.Members.Count = 0 Then
            Sheet2.Cells(wOutRow, 2) = "-empty-"
            wOutRow = wOutRow + 1
          Else
            For n = 1 To objAddressEntry.Members.Count
              Sheet2.Cells(wOutRow, 2) = objAddressEntry.Members(n)
              Select Case objAddressEntry.Members(n).DisplayType
               Case olUser
                Sheet2.Cells(wOutRow, 3) = "Individual"
                wColorIndex = 5
                wGroupColorIndex = xlColorIndexAutomatic
               Case olDistList
                Sheet2.Cells(wOutRow, 3) = "Group"
                wColorIndex = 54
               Case Else
                Sheet2.Cells(wOutRow, 3) = "unknown type"
                wColorIndex = 3
               End Select
              Sheet2.Range( _
                Sheet2.Cells(wOutRow, 2), _
                Sheet2.Cells(wOutRow, 3) _
                ).Font.ColorIndex = wColorIndex
              wOutRow = wOutRow + 1
            Next n
            Sheet2.Cells(wGroupRow, 1).Font.ColorIndex = wGroupColorIndex
          End If
        End If
        
        wRow = wRow + 1
      Loop
      
      Sheet2.Activate
      Sheet2.Cells(wOutRow, 2).Select
      Beep
      
    Set objAddressEntry = Nothing
    Set objAddressList = Nothing
    Set objNamespace = Nothing
    Set objOutlook = Nothing
    End Sub
    

    ____________________________________________________________
    Sheet2 should look like this:

    One eMail will be created for each group in the list below
    until a blank row is found.
    The eMail will be addressed to all of the individuals;
    groups will not be included.  If there are no individuals,
    the eMail will not be created.

    Adjust the list as needed, then click [Send eMail]  <-- this button is named cbSendEMail

    or, if you wish to edit the
    emails before they are sent, click [Create eMail]  <-- this button is named cbCreateEmails

    Group Name                                                                        }  this range (A5..D6)
        Member Name         Type          Response        }  is named Output_hdrs

    ____________________________________________________________
    The code for Sheet2 is:

    Dim objOL As New Outlook.Application
    Dim mSend As Boolean
    
    Private Sub cbCreateEmails_Click()
    
      mSend = False
      Call CommonProcess
    
    End Sub
    
    Private Sub cbSendEMail_Click()
    
      mSend = True
      Call CommonProcess
    
    End Sub
    
    Sub CommonProcess()
    Dim wRow As Long
    Dim wGroupRow As Long
    Dim wGroupName As String
    Dim wMailItem As Outlook.MailItem
    
      Set objOL = New Outlook.Application
    
      wRow = Range("Output_hdrs").Row + Range("Output_hdrs").Rows.Count
      
      Do While Not (IsEmpty(Cells(wRow, 1)) And IsEmpty(Cells(wRow, 2)))
      
        If Not IsEmpty(Cells(wRow, 1)) Then
          Cells(wRow, 1).Select
          wGroupName = Cells(wRow, 1)
          Set wMailItem = CreateEmail(wGroupName)
          wGroupRow = wRow
          wRow = wRow + 1
          Do While Not IsEmpty(Cells(wRow, 2))
            If Cells(wRow, 3) = "Individual" Then
              wMailItem.Recipients.Add Cells(wRow, 2)
            End If
            wRow = wRow + 1
          Loop
          If wMailItem.Recipients.Count > 0 Then
            If mSend Then
              wMailItem.Send
              Cells(wGroupRow, 4) = "sent"
            Else
              wMailItem.Display
              Cells(wGroupRow, 4) = "created"
            End If
          Else
            wMailItem.Delete
            Cells(wGroupRow, 4) = "skipped"
          End If
        End If
        
      Loop
    
      Set wMailItem = Nothing
      Set objOL = Nothing
    End Sub
    Function CreateEmail(aGroupName As String) As Outlook.MailItem
    Dim wMailItem As MailItem
    
      Set wMailItem = objOL.CreateItem(olMailItem)
    
      With wMailItem
        .HTMLBody _
          = "<font face=""Arial"" size=""2"">" _
          + "You are receiving this email because you are a member<br>" _
          + "of group <strong>" + aGroupName + "</strong><br>" _
          + "<br>" _
          + "Please respond by choosing one of the voting buttons..<br>" _
          + "<br>" _
          + "If you wish to continue to receive emails as part of this group, choose [Yes, Continue]<br>" _
          + "If you wish to be removed from this group, and not receive any more emails, choose [No, Stop]" _
          + "</font>"
        .Importance = olImportanceNormal
        .Subject = "eMail Group Review: " + aGroupName
        .VotingOptions = "YES, Continue;NO, Stop"
      End With
      
      Set CreateEmail = wMailItem
    End Function
    
    
    Let me know if you have any problems.  Dan
    Saturday, April 02, 2011 9:20 PM
  • Hi Dan,

    I created a new module in a new worksheet, and set up the 2 sheets.  I copied the first code into the new module, and when I run this macro, it doesn't get past the first line:

    Dim objOutlook As New Outlook.Application

    So, I tried typing in the line, and after As New, Outlook is not one of the available options.  If I do the same thing in a VBA macro in Outlook, then Outlook.Application is valid, but not in Excel.

    Am I missing something?

    Thanks!


    taxgirl
    Monday, April 04, 2011 4:28 AM
  • Hi Doug,

    I tried creating a Word macro and copying in the code you suggested.  When the macro got to the line

     Set ol = CreateObject("Outlook.Application")

    I got the error "Run-time error '429':  activeX component can't create object.

    Thanks!


    taxgirl
    Monday, April 04, 2011 4:33 AM
  • Works fine here, whether Outlook is running or not.  However try it both ways.


    Hope this helps.

    Doug Robbins - Word MVP,
    dkr[atsymbol]mvps[dot]org
    Posted via the Community Bridge

    "taxgirl" wrote in message news:e503efd0-3140-4b94-8b2f-720493aad84b@communitybridge.codeplex.com...

    Hi Doug,

    I tried creating a Word macro and copying in the code you suggested.  When the macro got to the line

     Set ol = CreateObject("Outlook.Application")

    I got the error "Run-time error '429':  activeX component can't create object.

    Thanks!


    taxgirl


    Doug Robbins - Word MVP dkr[atsymbol]mvps[dot]org
    Monday, April 04, 2011 8:27 AM
  • sorry.  I forget little things.. 

    You need the Outlook Object Library

    In the Visual Basic window,  Drop the Tools menu, and choose References..

    Find and check "Microsoft Outlook vv.m Object Library", and click [OK]

    Tuesday, April 05, 2011 2:03 AM
  • Thanks - it got a little farther this time!  However, at the line

    Set objAddressList = objNamespace.AddressLists("Global Address List")

    I got the error "Method 'AddressLists' of object'_NameSpace' failed'


    taxgirl
    Tuesday, April 05, 2011 4:45 AM
  • Hi Doug,

    It didn't make any difference whether I had Outlook open or closed.  However, after I went into Tools References to tick the Outlook 14.0 Object Library, then changed that line to read

      Set ol = New Outlook.Application

    the macro got all the way to the last line,

         ActiveDocument.Range.InsertAfter Contact.FullName & vbCr & Contact.BusinessAddress & vbCr & vbCr

    where it stopped, with the message Run-time error '438':

    Object doesn't support this property or method.
    I tried changing the last line to

      ActiveDocument.Range.InsertAfter (vbCr)

    and the macro worked, but provided me a document with some names and some e-mail addresses, and some address parts.

    Is there a way to change this macro so it will go through each "contact group", and provide a list that shows the contact group name and the e-mail address?  Or, the contact group name and the "display name" (which includes the e-mail address)?

    Thanks!


    taxgirl
    Tuesday, April 05, 2011 4:59 AM
  • I'm guessing that "Global Address List" is not an AddressList at your installation.  You will have to find out what is your equivalent.

     

    Put a stop on that line of code.  Add a watch on objNamespace.AddressLists.
    Execute the code.  When it stops, examine the Items properties; one of them should be named something obvious; try using that.

    Wednesday, April 06, 2011 6:17 PM