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.