Create vCards from a CSV file

A vCard (.vcf file) is a plain text file (try opening it in Notepad!) that contains contact information written in a special format. You can create your own vCards from a CSV file (or Excel sheet) by writing your data in the vCard format.

This sample Excel macro creates one vcard for each row of data, stopping when it hits the first row with a blank First name field. If you need other fields, add those fields to a contact and save it as a vCard (.vcf) then open it in Notepad to get the field name to use in the macro.

The fields are in this order:
Title (Dr. etc), First, Middle, Last, Suffix, Company, Job Title, email1, telwork, telhome, telcell, telfax, Work Street, Work city, Work State, Work Zip, Work Country, Home Street, Home City, Home State, Home Zip, Home Country, Default Mailing Address, URL, IM, birthday, Note, email2, email3

Note: This sample does not handle Street2 addresses or 'Other' address.

If the fields are in a different order in your data, either rearrange them in Excel or change the column number here: Cells(iRow, 5).

Valid entries for default mailing address are 1 (for Home address) or 2 (for Work address).

If you need to create one multi-card VCF file, move iRow = iRow + 1 above this line: Close #FileNum. You'll also want to change the filename to something generic, such as OutFilePath = ThisWorkbook.Path & "\VCardOutput.vcf"

Sub CreatevCardsCSV()
    
' CSV fields are in this order:
' Title (Dr. etc), First, Middle, Last, Suffix, Company, Job Title, email1,
' telwork, telhome, telcell, telfax,
' Work Street, Work city, Work State, Work Zip, Work Country
' Home Street, Home City, Home State, Home Zip, Home Country
' Default Mailing Address - Valid entry is 1 (Home) 2 (Work)
' URL, IM, bday, Note, email2, email3
   
   
   
    Dim FileNum As Integer
    Dim iRow As Double
    iRow = 2
    FileNum = FreeFile
 
    'Loop through rows and create a vcard
    'until the first name field is empty
    While VBA.Trim(Sheets("Sheet1").Cells(iRow, 2)) <> ""

     fName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 2))
     lName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 4))
 
    OutFilePath = ThisWorkbook.Path & "\" & fName & " " & lName & ".vcf"
    Open OutFilePath For Output As FileNum

 nTitle = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1))
 mName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 3))
 nSuffix = VBA.Trim(Sheets("Sheet1").Cells(iRow, 5))
 Company = VBA.Trim(Sheets("Sheet1").Cells(iRow, 6))
 jobTitle = VBA.Trim(Sheets("Sheet1").Cells(iRow, 7))
 email1 = VBA.Trim(Sheets("Sheet1").Cells(iRow, 8))
 telWork = VBA.Trim(Sheets("Sheet1").Cells(iRow, 9))
 telHome = VBA.Trim(Sheets("Sheet1").Cells(iRow, 10))
 telCell = VBA.Trim(Sheets("Sheet1").Cells(iRow, 11))
 telFax = VBA.Trim(Sheets("Sheet1").Cells(iRow, 12))
 AddrWorkStr = VBA.Trim(Sheets("Sheet1").Cells(iRow, 13))
 AddrWorkCity = VBA.Trim(Sheets("Sheet1").Cells(iRow, 14))
 AddrWorkState = VBA.Trim(Sheets("Sheet1").Cells(iRow, 15))
 AddrWorkZip = VBA.Trim(Sheets("Sheet1").Cells(iRow, 16))
 AddrWorkCountry = VBA.Trim(Sheets("Sheet1").Cells(iRow, 17))
 AddrHomeStr = VBA.Trim(Sheets("Sheet1").Cells(iRow, 18))
 AddrHomeCity = VBA.Trim(Sheets("Sheet1").Cells(iRow, 19))
 AddrHomeState = VBA.Trim(Sheets("Sheet1").Cells(iRow, 20))
 AddrHomeZip = VBA.Trim(Sheets("Sheet1").Cells(iRow, 21))
 AddrHomeCountry = VBA.Trim(Sheets("Sheet1").Cells(iRow, 22))
 defaultAddr = VBA.Trim(Sheets("Sheet1").Cells(iRow, 23))
 URL = VBA.Trim(Sheets("Sheet1").Cells(iRow, 24))
 IM = VBA.Trim(Sheets("Sheet1").Cells(iRow, 25))
 BDAY = VBA.Trim(Sheets("Sheet1").Cells(iRow, 26))
 NOTE = VBA.Trim(Sheets("Sheet1").Cells(iRow, 27))
 email2 = VBA.Trim(Sheets("Sheet1").Cells(iRow, 28))
 email3 = VBA.Trim(Sheets("Sheet1").Cells(iRow, 29))

        Print #FileNum, "BEGIN:VCARD"
        Print #FileNum, "VERSION:3.0"
        Print #FileNum, "N:" & lName & ";" & fName & ";" & mName & ";" & nTitle & ";" & nSuffix
        Print #FileNum, "FN:" & nTitle & " " & fName & " " & mName & " " & lName & " " & nSuffix
        Print #FileNum, "ORG:" & Company
        Print #FileNum, "TITLE:" & jobTitle
        Print #FileNum, "TEL;WORK;VOICE:" & telWork
        Print #FileNum, "TEL;HOME;VOICE:" & telHome
        Print #FileNum, "TEL;CELL;VOICE:" & telCell
        Print #FileNum, "TEL;WORK;FAX:" & telFax
        Print #FileNum, "ADR;WORK;PREF:;;" & AddrWorkStr & ";" & AddrWorkCity & ";" & AddrWorkState & ";" & AddrWorkZip & ";" & AddrWorkCountry
        Print #FileNum, "ADR;Home:;;" & AddrHomeStr & ";" & AddrHomeCity & ";" & AddrHomeState & ";" & AddrHomeZip & ";" & AddrHomeCountry
        Print #FileNum, "X-MS-OL-DEFAULT-POSTAL-ADDRESS:" & defaultAddr
        Print #FileNum, "URL;WORK:" & URL
        Print #FileNum, "X-MS-IMADDRESS:" & IM
        Print #FileNum, "Note:" & NOTE
        Print #FileNum, "BDAY:" & BDAY
        Print #FileNum, "EMAIL;PREF;INTERNET:" & email1
        Print #FileNum, "EMAIL;INTERNET:" & email2
        Print #FileNum, "EMAIL;INTERNET:" & email3
        
        
        Print #FileNum, "END:VCARD"

    'Close the File
    Close #FileNum

        iRow = iRow + 1
    Wend
 
    MsgBox iRow - 2 & " Contacts Converted."
End Sub

To use this macro, open the CSV in Excel (or create a new CSV) and press Alt+F11 to open the VB Editor. Paste the macro into a module and run it.