Outlook Kontakte downloaden (global kontacts)

Sub OK_AdressenVonOutlook()
Dim workingFolder As Object
Dim i As Integer
Dim olMAPI As New OutLook.Application
Range("A2").Select
Set workingFolder = olMAPI.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts) 'muss hier was verändert werden?
For i = 1 To workingFolder.Items.Count
Set objItem = workingFolder.Items(i)
With objItem
ActiveCell.Value = .FirstName
ActiveCell.Offset(0, 1).Value = .LastName
ActiveCell.Offset(0, 2).Value = .BusinessAddress
ActiveCell.Offset(0, 3).Value = .Email1Address
ActiveCell.Offset(0, 4).Value = .HomeTelephoneNumber
ActiveCell.Offset(0, 5).Value = .BusinessTelephoneNumber
ActiveCell.Offset(0, 6).Value = .BusinessFaxNumber
ActiveCell.Offset(0, 7).Value = .Birthday
End With
ActiveCell.Offset(1, 0).Select
Next i
Set objItem = Nothing
Set olMAPI = Nothing
End Sub