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.
Get a Syntax error at
While VBA.Trim(Sheets("Sheet1").Cells(iRow, 2)) <> ""
is it showing in your code with the land than and greater than brackets? The code on the page was messed up and had the html representation of & lt; and & gt; (without the spaces). (I fixed it).
Otherwise, is your sheet named sheet1?
Diane, you seem to be the online BCM expert. Can the Small Business Level of Exchange365 host the BCM database allowing multiple users to sign in and sync? If not, is there a cloud hosting solution for multiple users to remote share a corporate BCM database? . . . Thanks much, Tod
Yes... but only if BCM is installed within your local network. You can't access it over the Internet (unless you use VPN.)
Brilliant macro, exactly what I needed. Just a little correction on line 74:
replace
Print #FileNum, "BDAY:"; 19871221
with
Print #FileNum, "BDAY:" & BDAY
Thanks for catching that. I did it during testing and forgot to change it back.
one multi-card VCF file instructions *not working...
What exactly happens? Do you get any error messages?
It only creates the vcard of the last contact