使用 VBA 从 Excel 生成 VCard

Question

我正在考虑创建一个 Excel 文件，在其中手动填写多个联系人信息，以便我可以将联系人（一个接一个）或全部导出到指定目录中的各个 vcf 文件。我想最好的方法是通过 VBA，但我知识不太丰富，需要一点推动。

请参阅下面带有联系人字段的 Excel 文件的屏幕截图。

任何指导将不胜感激。

好的，所以我首先开始解决将每一行导出到单独的 vcard 的问题。我遵循以下策略：

1. 创建临时新工作表 (tmp)
2. 粘贴标题：BEGIN:VCARD 版本：3.0
3. 根据我的图像复制粘贴第四行，以便它包含 VCARD 的 ID 以及我尝试导出的行（在第一种情况下为第 6 行）。我将它们粘贴到工作表 tmp 中。

我陷入了这个阶段，因为 vcard 用于某些字段的方式是用“;”分隔它们。并且他们处于不同的位置。我不知道如何通过查看第 4 行的字段在 VBA 中生成这些内容。即：N1 和 N2 应该为我创建行：N:Stuart;Carol。ADR 字段也是如此。

生成完整代码后，我就有了生成 VCARD 文件的代码。

此时任何帮助将不胜感激。

Answer 1

我就是这样做的。创建一个名为 CContact 的类，其中包含这些属性的 getter 和 setter。

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

创建一个 CContacts 类来保存所有 CContact 实例。在 CContacts 中，创建一个 FillFromRange 方法来加载所有联系人。

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

创建过程来填充类，如下所示

Public Sub Auto_Open()

    Initialize

End Sub

Public Sub Initialize()

    Set gclsContacts = New CContacts

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

End Sub

对于本示例，我使用双击事件。当您双击联系人时，就会创建电子名片。您需要修改才能使用按钮。获取单击以确定行的按钮的 TopLeftCell 属性。

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

它从 C 列获取 ID 并调用 CreateVCardFile 方法来写出文件。

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

这只是构建一个字符串并写入文件。此示例不符合 VCard 规范，因此您必须计算出这些细节。对于此方法，您需要一些常量和一个用于创建文件名的属性。

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;"

以及文件名属性

Public Property Get VCardFileName() As String

    VCardFileName = Me.LastName & "_" & Me.FirstName & ".vcf"

End Property

您可以通过下载此文件来查看省略的详细信息以及它们如何协同工作。

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