vba get contact name in outlook

Sub macro1()
    Dim otlk As Object
    Dim nmspc As Object
    Dim addrlst As Object
    Dim i As Long
    On Error GoTo errHandle
    Set otlk = CreateObject("Outlook.Application")
    Set nmspc = otlk.GetNamespace("MAPI")
    Set addrlst = nmspc.AddressLists("联系人")
    For i = 1 To addrlst.AddressEntries.Count
        Cells(i, 1).Value = addrlst.AddressEntries(i).Name
        Cells(i, 2).Value = addrlst.AddressEntries(i).Address
    Next i
errHandle:
    otlk.Quit
    Set otlk = Nothing

End Sub