Creating VCards from Excel with VBA

Question

I am looking for creating an excel file in which I would manually fill in several contacts so that I can export contacts (one by one) or all of them into separate vcf files in the specified directory. I believe that the best way would be through VBA, but I am not very clear and need a little click.

See below screenshot of excel file with contact fields.

Any guidance is appreciated.

OK, so I first started by addressing the export of each line to a separate vcard. I follow the following strategy:

• Create a temporary new worksheet (tmp)
• Insert Headers: START: VCARD VERSION: 3.0
• Copy paste the 4th line according to my image so that it includes the identifiers for VCARD, as well as the line I'm trying to export (in this first line of line 6). I insert them transposed into the tmp worksheet.

I am stuck at this point, since the way vcard is used for certain fields is to split them into ";" and they are in different positions. I do not know how I can generate them in VBA by looking at the fields of line 4. ie .: N1 and N2 should create a line for me: N: Stuart; Carol. The same thing happens for the ADR field.

I have code to create a VCARD file after creating the full code.

Any help at this point would be appreciated.

Answer 1

This is how I do it. Create a CContact class with getters and setters for these properties.

Private mlContactID As Long Private msLastName As String Private msFirstName As String Private msJobTitle As String Private msCompany As String Private msDepartment As String Private msEmail As String Private msBusinessPhone As String Private msCellPhone As String Private msPager As String Private msFax As String 

Create a CContacts class to hold all instances of CContact. In CContacts, create a FillFromRange method to load all contacts.

 Public Sub FillFromRange(rRng As Range) Dim vaValues As Variant Dim i As Long Dim clsContact As CContact vaValues = rRng.Value For i = LBound(vaValues, 1) To UBound(vaValues, 1) Set clsContact = New CContact With clsContact .ContactID = vaValues(i, 1) .LastName = vaValues(i, 2) .FirstName = vaValues(i, 3) .JobTitle = vaValues(i, 4) .Company = vaValues(i, 5) .Department = vaValues(i, 6) .Email = vaValues(i, 7) .BusinessPhone = vaValues(i, 8) .CellPhone = vaValues(i, 9) .Pager = vaValues(i, 10) .Fax = vaValues(i, 11) End With Me.Add clsContact Next i End Sub 

Create procedures to populate classes like

 Public Sub Auto_Open() Initialize End Sub Public Sub Initialize() Set gclsContacts = New CContacts gclsContacts.FillFromRange Sheet1.Range("C6").CurrentRegion End Sub 

In this example, I am using a double-click event. When you double-click on a contact, a vcard is created. You will need to change to use the buttons. Get the TopLeftCell property of the button that was clicked to define the row.

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim lContactID As Long lContactID = Me.Cells(Target.Row, 3).Value If gclsContacts Is Nothing Then Initialize If lContactID <> 0 Then gclsContacts.Contact(CStr(lContactID)).CreateVCardFile End If End Sub 

Gets the identifier from column C and calls the CreateVCardFile method to write the file.

 Public Sub CreateVCardFile() Dim sFile As String, lFile As Long Dim aOutput(1 To 12) As String lFile = FreeFile sFile = ThisWorkbook.Path & Application.PathSeparator & Me.VCardFileName Open sFile For Output As lFile aOutput(1) = gsBEGIN aOutput(2) = gsLASTNAME & Me.LastName aOutput(3) = gsFIRSTNAME & Me.FirstName aOutput(4) = gsTITLE & Me.JobTitle aOutput(5) = gsCOMPANY & Me.Company aOutput(6) = gsDEPARTMENT & Me.Department aOutput(7) = gsEMAIL & Me.Email aOutput(8) = gsBUSINESSPHONE & Me.BusinessPhone aOutput(9) = gsCELLPHONE & Me.CellPhone aOutput(10) = gsPAGER & Me.Pager aOutput(11) = gsFAX & Me.Fax aOutput(12) = gsEND Print #lFile, Join(aOutput, vbNewLine) Close lFile End Sub 

It is just building a line and writing to a file. This example does not apply to the VCard specification, so you will have to develop these details. For this method, you will need some constants and a property that creates the file name.

 Public Const gsBEGIN As String = "BEGIN:VCARD VERSSION: 3.0" Public Const gsEND As String = "END" Public Const gsLASTNAME As String = "N1;" Public Const gsFIRSTNAME As String = "N2;" Public Const gsTITLE As String = "TITLE;" Public Const gsCOMPANY As String = "ORG1;" Public Const gsDEPARTMENT As String = "ORG2;" Public Const gsEMAIL As String = "EMAIL,TYPE=WORK;" Public Const gsBUSINESSPHONE As String = "TEL,TYPE=WORK;" Public Const gsCELLPHONE As String = "TEL,TYPE=CELL;" Public Const gsPAGER As String = "TEL,TYPE=PAGER;" Public Const gsFAX As String = "TEL,TYPE=WORK,TYPE=FAX;" 

And the file name property

 Public Property Get VCardFileName() As String VCardFileName = Me.LastName & "_" & Me.FirstName & ".vcf" End Property 

You can see the omitted details and how they work together by downloading this file.

http://dailydoseofexcel.com/excel/VCardCreator.zip

Answer 2

EDIT: If you admitted that you have practically no useful knowledge of the Visual Basic language, and in fact you need a SOLUTION, and not just a hint or “push”, as you call it. The solution should not be confused with simple "help." I would come up with a much shorter code to achieve the goal of your excel worksheet, exporting it to any format if you mentioned the specific result you intended (and I mean the vCard code example) in a very short time and without requiring any more help with your side. But you act like a professional who just needs a push ... if there is such a thing. Again, this is not about pride, and (I hope), I am offensive, I just criticize this act to throw a hint at the limits of this particular site.

Your question is quite general, and I think that the purpose of this site is to find answers to specific questions and not provide solutions to problems of application complexity. This is my first attempt, maybe I'm wrong, but it seems to me that this question has the right to vote for the description "this question does not show any research, it is unclear or not useful."

However, if all you need is really pushing, then you can find information on the VCard file format on Wikipedia (with examples) - it says that the latest version of the format is XML, so it should be easy for you if you know how to manipulate rows in Visual Basic and access the contents of an Excel cell from a script. http://en.wikipedia.org/wiki/VCard

If you do not, you can learn to practice as needed on websites such as http://www.excel-vba-easy.com/

Try and come back with a more specific problem. I would just comment on the question and not "answer", but I could not find a way to this.

Answer 3

I have a sample Excel worksheet and its corresponding VBA code. Excel sheet sample

and here is the corresponding VBA code to convert it to vcf type.

 Private Sub Create_VCF() 'Open a File in Specific Path in Output or Append mode Dim FileNum As Integer Dim iRow As Integer Dim FirstName As String Dim LastName As String Dim FullName As String Dim EmailAddress As String Dim PhoneHome As String Dim PhoneWork As String Dim Organization As String Dim JobTitle As String iRow = 3 FileNum = FreeFile OutFilePath = "C:\output.VCF" Open OutFilePath For Output As FileNum 'Loop through Excel Sheet each row and write it to VCF File While VBA.Trim(Sheets("Sheet1").Cells(iRow, 1)) <> "" FirstName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 1)) LastName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 2)) FullName = VBA.Trim(Sheets("Sheet1").Cells(iRow, 3)) EmailAddress = VBA.Trim(Sheets("Sheet1").Cells(iRow, 4)) PhoneWork = VBA.Trim(Sheets("Sheet1").Cells(iRow, 5)) PhoneHome = VBA.Trim(Sheets("Sheet1").Cells(iRow, 6)) Organization = VBA.Trim(Sheets("Sheet1").Cells(iRow, 7)) JobTitle = VBA.Trim(Sheets("Sheet1").Cells(iRow, 8)) Print #FileNum, "BEGIN:VCARD" Print #FileNum, "VERSION:3.0" Print #FileNum, "N:" & FirstName & ";" & LastName & ";;;" Print #FileNum, "FN:" & FullName Print #FileNum, "ORG:" & Organization Print #FileNum, "TITLE:" & JobTitle Print #FileNum, "TEL;TYPE=HOME,VOICE:" & PhoneHome Print #FileNum, "TEL;TYPE=WORK,VOICE:" & PhoneWork Print #FileNum, "EMAIL:" & EmailAddress Print #FileNum, "END:VCARD" iRow = iRow + 1 Wend 'Close The File Close #FileNum MsgBox "Contacts Converted to Saved To: " & OutFilePath & " End Sub 

Thanks, I hope this helps.