VBA scipt doesnt get all contacts from Outlook

Hi all

i need all my Conctacts (2500) but only the data below

Sub ExportOutlookAddressBook()
'DEVELOPER: Ryan Wells (wellsr.com)
'DESCRIPTION: Exports your Outlook Address Book to Excel.
'NOTES: This macro runs on Excel.
' Add the Microsoft Outlook Reference library to the project to get this to run
Application.ScreenUpdating = False
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olAL As Outlook.AddressList
Dim olEntry As Outlook.AddressEntry
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olAL = olNS.AddressLists("Contacts") 'Change name if different contacts list name
ActiveWorkbook.ActiveSheet.Range("a5").Select
For Each olEntry In olAL.AddressEntries
' your looping code here
ActiveCell.Value = olEntry.GetContact.Gender 'gender
ActiveCell.Offset(0, 1).Value = olEntry.GetContact.FirstName 'firstname
ActiveCell.Offset(0, 2).Value = olEntry.GetContact.LastName 'lastname
ActiveCell.Offset(0, 3).Value = olEntry.GetContact.CompanyName 'company
ActiveCell.Offset(0, 4).Value = olEntry.GetContact.JobTitle 'function
ActiveCell.Offset(0, 5).Value = olEntry.GetContact.MobileTelephoneNumber 'phonenumber
ActiveCell.Offset(0, 6).Value = olEntry.GetContact.Email1Address 'email
ActiveCell.Offset(0, 7).Value = olEntry.GetContact.BusinessAddress 'adress
ActiveCell.Offset(1, 0).Select
DoEvents
Next olEntry
Set olApp = Nothing
Set olNS = Nothing
Set olAL = Nothing
Application.ScreenUpdating = True
End Sub

it outputs around 1000 contacts even if they all under the same folder (Contacts)
even worst when i saw that there some contacts that where listed twice :/

thanks for your help guys

kr
Chichox