Question

我正在创建一个excel文件，我会在其中手动填写多个联系人信息，以便我可以将联系人（逐个）或所有联系人导出到指定目录中的各个vcf文件。我想最好的方法是通过VBA，但我不是很了解，需要一点推力。

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

enter image description here

非常感谢任何指导。

好的，所以我最初开始时将每行导出到一个单独的vcard。我遵循以下策略：

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

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

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

此时的任何帮助都将受到赞赏。

Answer 1

这是我将如何做到的。使用这些属性的getter和setter创建一个名为CContact的类。

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

对于此示例，我正在使用双击事件。双击联系人时，将创建vcard。您需要修改才能使用按钮。获取单击按钮的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

Answer 2

编辑：如果你承认你几乎没有对Visual Basic语言的有用知识，事实上你需要一个解决方案，而不仅仅是你所说的提示或“推”。解决方案不要与简单的“帮助”相混淆。我想出一个更短的代码来完成excel工作表的目标，将其导出为任何格式，前提是你在很短的时间内提到了你想要的具体结果（我的意思是一个vCard代码的例子）并且无需您的任何帮助。但你就像一个只需要推动的专业人士...如果有这样的事情。同样，这不是关于骄傲，也不是（我希望）我是冒犯性的，我只是在批评该行为对这个特定网站的限制提出暗示。

您的问题相当笼统，我认为本网站的目的是找到特定问题的答案，而不是解决应用程序复杂性的问题。这是我的第一次尝试，也许我错了，但我这个问题似乎有资格根据描述投票“这个问题没有显示任何研究工作。它不清楚或没有用”。

但是，如果您只需要推送，那么您可以在Wikipedia上找到有关VCard文件格式的信息（带示例） - 它说该格式的最新版本是XML，所以如果您知道它应该很容易如何在Visual Basic中操作字符串并从脚本访问Excel单元格内容。 http://en.wikipedia.org/wiki/VCard

如果您不这样做，您可以在http://www.excel-vba-easy.com/

等网站上根据需要练习

尝试，并返回更具体的问题。我只是简单地评论了这个问题，而不是“回答”，但我还没有找到办法。

Answer 3

我有一个示例excel表和与其对应的VBA代码。 sample excel sheet

这是将其转换为vcf类型的相应VBA代码。

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

谢谢，我希望这会有所帮助。

使用VBA从Excel生成VCards

3 个答案: