Hi, I found this VBA script out on the internet; There were two scripts. One which extracts names from local contacts (which works) and this one which should extract names from a list on the Global Address List (GAL).
My problem is that it errors on this line: Dim olApp As Outlook.Application The error is : User Defined type is not defined. As a newbie to VBA, I find this confusing. Any help? Here is the code: Function WriteGALMembersToExcel(ListName As String) As Boolean ' adapted from http://www.slovaktech.com/code_samples.htm#DLToWord ' writes dist list members to a worksheet, one row for each contact in dist list On Error GoTo ErrorHandler Dim olApp As Outlook.Application '<---- error is here Dim olNS As Outlook.Namespace Dim olAL As Outlook.AddressList Dim olEntry As Outlook.AddressEntry Dim oldlMember As Outlook.AddressEntry Set olApp = Outlook.Application Set olNS = olApp.GetNamespace("MAPI") Set olAL = olNS.AddressLists("Global Address List") Set olEntry = olAL.AddressEntries(ListName) ' get count of dist list members Dim lMemberCount As Long lMemberCount = olEntry.Members.Count ' create temp variant and set size to one row for each contact Dim tempVar As Variant ReDim tempVar(1 To lMemberCount, 1 To 2) ' loop through dist list and extract members Dim i As Long For i = 1 To lMemberCount Set oldlMember = olEntry.Members.Item(i) tempVar(i, 1) = oldlMember.Name tempVar(i, 2) = oldlMember.Address Next i ' get new Excel instance Dim xlApp As Object ' Excel.Application Dim xlBk As Object ' Excel.Workbook Dim xlSht As Object ' Excel.Worksheet Dim rngStart As Object ' Excel.Range Dim rngHeader As Object ' Excel.Range Set xlApp = GetExcelApp If xlApp Is Nothing Then GoTo ExitProc xlApp.ScreenUpdating = False Set xlBk = xlApp.Workbooks.Add Set xlSht = xlBk.Sheets(1) ' set up worksheet and write to range xlSht.Name = ListName Set rngStart = xlSht.Range("A1") Set rngHeader = xlSht.Range(rngStart, rngStart.Offset(0, 1)) rngHeader.Value = Array("Name", "Email Address") rngStart.Offset(1, 0).Resize(UBound(tempVar), 2).Value = tempVar ' if we got this far, assume success WriteGALMembersToExcel = True xlApp.Visible = True GoTo ExitProc ErrorHandler: ExitProc: On Error Resume Next Erase tempVar Set rngHeader = Nothing Set rngStart = Nothing Set xlSht = Nothing Set xlBk = Nothing Set xlApp = Nothing Set olAL = Nothing Set olEntry = Nothing Set olNS = Nothing Set olApp = Nothing End Function Function GetExcelApp() As Object ' always create new instance On Error Resume Next Set GetExcelApp = CreateObject("Excel.Application") On Error GoTo 0 End Function Sub test() Dim success As Boolean success = WriteGALMembersToExcel("Executive Management") End Sub --~--~---------~--~----~------------~-------~--~----~ ---------------------------------------------------------------------------------- Some important links for excel users: 1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at http://www.excelitems.com 2. Excel tutorials at http://www.excel-macros.blogspot.com 3. Learn VBA Macros at http://www.vbamacros.blogspot.com 4. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com If you find any spam message in the group, please send an email to: Ayush Jain @ jainayus...@gmail.com or Ashish Jain @ 26may.1...@gmail.com <><><><><><><><><><><><><><><><><><><><><><> HELP US GROW !! We reach over 5,000 subscribers worldwide and receive many nice notes about the learning and support from the group. Our goal is to have 10,000 subscribers by the end of 2009. Let friends and co-workers know they can subscribe to group at http://groups.google.com/group/excel-macros/subscribe -~----------~----~----~----~------~----~------~--~---
