Hi.

In the VBE window, click on the Tools / References menu and select
"Microsoft Outlook nn Object Library" where "nn" depends of your version of
Office.
Alternatively, you can write :
Dim olApp As Object

Regards.

Daniel

> -----Original Message-----
> From: excel-macros@googlegroups.com [mailto:excel-
> mac...@googlegroups.com] On Behalf Of OldDog
> Sent: jeudi 23 juillet 2009 18:50
> To: MS EXCEL AND VBA MACROS
> Subject: $$Excel-Macros$$ extract distribution list members to excel
> 
> 
> 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
-~----------~----~----~----~------~----~------~--~---

Reply via email to