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.