Generate VCards from Excel using VBA

Question

I am looking at creating an excel file where I would manually fill in multiple contacts information so that I can export the contacts (one by one) or all of them to individual vcf files within a specified directory. I imagine that the best way would be through VBA but I am not very knowleadgeable and need a little push.

Please see below screenshot of the excel file with contact fields.

Any guidance will be greatly appreciated.

OK, So I have initially started by addressing exporting each row to an individual vcard. I am following the following strategy:

1. Create a temporary new worksheet (tmp)
2. Paste the Headers: BEGIN:VCARD VERSION: 3.0
3. Copy paste the 4th row as per my image so that it includes the IDs of for the VCARD and also the row I am trying to export (in this first case row 6). I paste them transposed to worksheet tmp.

I get stuck at this stage as the way the vcard is used for certain fields is by separating them with ";" and they are in different positions. I do not know how i can generate these in VBA by looking at the fields of row 4. ie.: N1 and N2 should create me the line: N:Stuart;Carol. And the same happens for the ADR field.

I have the code to generate the VCARD file once this full code is generated.

Any help at this point will be appreciated.

Answer 1

Here's how I would do it. Create a class called CContact 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 the CContact instances. In CContacts, create a FillFromRange method to load up all of the 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 fill the classes, like this

Public Sub Auto_Open()

    Initialize

End Sub

Public Sub Initialize()

    Set gclsContacts = New CContacts

    gclsContacts.FillFromRange Sheet1.Range("C6").CurrentRegion

End Sub

For this example, I'm using the double click event. When you double click a contact, the vcard is created. You'll need to modify to use buttons. Get the TopLeftCell property of the button that was clicked to determine 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

That gets the ID from column C and calls the CreateVCardFile method to write out 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

That's just building a string and writing to a file. This example isn't to VCard spec, so you'll have to work out those details. For this method, you'll 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 it works together by downloading this file.

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