Hi,

Can someone tell me why this code only shows 1 filled row and leaves
the rest blank (number of rows is correct but they are all blank but
1).


Public Function Addresses()
Dim ol As Object
Dim olns As Object
Dim objFolder As Object
Dim objAllContacts As Object
Dim Contact As Object
Dim MyAddressAs String


Set ol = New Outlook.Application


Set olns = ol.GetNamespace("MAPI")


Set MyFolder1 = olns.Folders("Public Folders")
Set MyFolder2 = MyFolder1.Folders("All Public Folders")
Set MyFolder3 = MyFolder2.Folders("MyPublicFolder")


Set objAllContacts = MyFolder3.Items


Dim TotalCount, Counter As Long
TotalCount = MyFolder3.Items.Count


Counter = 1
Dim ContactArray As Variant


For Each Contact In objAllContacts


ReDim ContactArray(Counter, 1) As Variant


MyAddress= Contact.BusinessAddressStreet + ", " +
Contact.BusinessAddressPostalCode + " " + Contact.BusinessAddressCity
ContactArray(Counter, 0) = Contact.CompanyName
ContactArray(Counter, 1) = MyAddress


Counter = Counter + 1
Next Contact


CForm.MyListBox.ColumnCount = 2
CForm.MyListBox.List = ContactArray


End Function


Thanx in advance
Greetings Depez