vba

'Option Explicit

Sub Export_PAB_to_vcfs()

Dim myOlApp As Outlook.Application
Dim objContact As ContactItem

Set myOlApp = New Outlook.Application

Set olns = myOlApp.GetNamespace("MAPI")

' Set MyFolder to the default contacts folder.
Set myFolder1 = olns.Folders("Sean O'Reilly")
Set myfolder = myFolder1.Folders("Contacts")

' Get the number of items in the folder.
NumItems = myfolder.Items.Count

' Loop through all of the items in the folder.
For i = 1 To NumItems
    Debug.Print myfolder.Items(i).Class
    If myfolder.Items(i).Class = 40 Then
        Set objContact = myfolder.Items(i)
        Debug.Print TypeName(objContact) + ":" + objContact.FullName
        If Not TypeName(objContact) = "Nothing" Then
            If Not objContact.FullName = "" Then
              strname = "H:\Personal\Contacts\" & TrimALL(objContact.FullName) & ".vcf"
             objContact.SaveAs strname, olVCard
            End If
        End If
    End If
Next

MsgBox "All Contacts Exported!"

End Sub