Outlook Export Contacts

Sub ExportMultipleContactsIntoOneVCardFile()
    Dim objSelection As Outlook.Selection
    Dim strLocalDrive, strFolder As String
    Dim i As Long
    Dim objContact As Outlook.ContactItem
    Dim strVCardFile As String
    Dim s As String

    'Get all selected contacts
    Set objSelection = Outlook.Application.ActiveExplorer.Selection

    If Not objSelection Is Nothing Then
       'Save contacts in "E:\Temp Contacts\"
       strLocalDrive = "c:"
       strFolder = "Users\gerneu\OneDrive\Documents\vCards"
       ' MkDir (strLocalDrive & "\" & strFolder & "\")

       'Save all selected contacts as separate vCards
       For i = objSelection.count To 1 Step -1
           If TypeName(objSelection(i)) = "ContactItem" Then
              Set objContact = objSelection(i)

                s = objContact.FullName
                s = Replace(s, "/", "-")

              strVCardFile = strLocalDrive & "\" & strFolder & "\" & s & ".vcf"
              objContact.SaveAs strVCardFile, olVCard
           End If
       Next

       'Use cmd to merge all exported vCard files into one
       Shell "cmd.exe /K" & strLocalDrive & " & CD " & strFolder & " & copy *.vcf MergedContact.vcf"
    End If
End Sub