使用 VBA 从 Excel 生成 VCard
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/13294356/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Generate VCards from Excel using VBA
提问by macutan
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.
我正在考虑创建一个 excel 文件,我将在其中手动填写多个联系人信息,以便我可以将联系人(一个接一个)或全部导出到指定目录中的单个 vcf 文件。我想最好的方法是通过 VBA,但我不是很了解,需要一点推动。
Please see below screenshot of the excel file with contact fields.
请参阅下面带有联系人字段的 excel 文件的屏幕截图。
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:
好的,所以我最初开始解决将每一行导出到单个 vcard 的问题。我遵循以下策略:
- Create a temporary new worksheet (tmp)
- Paste the Headers: BEGIN:VCARD VERSION: 3.0
- 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.
- 创建临时新工作表 (tmp)
- 粘贴标题:BEGIN:VCARD 版本:3.0
- 根据我的图像复制粘贴第 4 行,以便它包含 VCARD 的 ID 以及我尝试导出的行(在第一种情况下为第 6 行)。我将它们转置到工作表 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.
我陷入了这个阶段,因为 vcard 用于某些字段的方式是用“;”分隔它们。他们处于不同的位置。我不知道如何通过查看第 4 行的字段在 VBA 中生成这些。即:N1 和 N2 应该为我创建行:N:Stuart;Carol。ADR 领域也是如此。
I have the code to generate the VCARD file once this full code is generated.
一旦生成了完整的代码,我就有了生成 VCARD 文件的代码。
Any help at this point will be appreciated.
在这一点上的任何帮助将不胜感激。
采纳答案by Dick Kusleika
Here's how I would do it. Create a class called CContact with getters and setters for these properties.
这是我将如何做到的。使用这些属性的 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
Create a CContacts class to hold all the CContact instances. In CContacts, create a FillFromRange method to load up all of the contacts.
创建一个 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
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.
在这个例子中,我使用了双击事件。当您双击联系人时,将创建 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
That gets the ID from column C and calls the CreateVCardFile method to write out the file.
它从 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
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.
这只是构建一个字符串并写入文件。此示例不符合 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;"
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.
您可以通过下载此文件查看省略的详细信息以及它们如何协同工作。
回答by bitoolean
EDIT: Had you admitted you have practically no useful knowledge of the Visual Basic language, and in fact you needed a SOLUTION, not merely a hint or "push" as you call it. A solution is not to be confused with simple "help". I would have come up with a much shorter code to accomplish the goal of your excel worksheet, exporting it to whatever format, provided you mentioned the specific result you intended (and I mean an example of a vCard code) in a very much shorter time and without requiring any more help from your side. But you're acting like a professional who just needs a push... if there is such a thing. Again, this is not about pride, nor (I hope) am I being offensive, I'm just criticizing the act to drop a hint regarding the limits of this particular site.
编辑:如果您承认您对 Visual Basic 语言几乎没有任何有用的知识,实际上您需要一个解决方案,而不仅仅是您所说的提示或“推送”。不要将解决方案与简单的“帮助”混淆。我会想出一个更短的代码来完成你的 excel 工作表的目标,将它导出为任何格式,前提是你在更短的时间内提到了你想要的特定结果(我的意思是一个电子名片代码的例子)并且无需您提供更多帮助。但是你表现得像一个需要推动的专业人士......如果有这样的事情。再说一次,这不是关于骄傲,也不是(我希望)我是冒犯,我只是批评这种行为,以暗示有关该特定站点的限制。
Your question is rather general, and I think the purpose of this website is to find answers to specific issues and not giving solutions to problems of the complexity of an application. This being my first try, maybe I'm wrong, but I this question seems to be eligible for a down vote per the description "this question does not show any research effort. it is unclear or not useful".
你的问题比较笼统,我认为这个网站的目的是找到具体问题的答案,而不是针对应用程序的复杂性问题提供解决方案。这是我的第一次尝试,也许我错了,但我这个问题似乎有资格根据描述“这个问题没有显示任何研究工作。不清楚或没有用”。
However, if all you need is a push indeed, then you can find information on the VCard file format on Wikipedia (with examples) - it says the latest version of the format is XML, so it should be easy if you know how to manipulate strings in Visual Basic and access Excel cell contents from a script. http://en.wikipedia.org/wiki/VCard
但是,如果您确实需要推送,那么您可以在维基百科上找到有关 VCard 文件格式的信息(带有示例)-它说该格式的最新版本是 XML,因此如果您知道如何操作,应该很容易字符串并从脚本访问 Excel 单元格内容。 http://en.wikipedia.org/wiki/VCard
If you don't, you can learn by practice on a per-needed basis at websites such as http://www.excel-vba-easy.com/
如果您不这样做,您可以根据需要在http://www.excel-vba-easy.com/等网站上通过实践学习
Try, and return with a more specific issue. I would've simply commented on the question instead of "answering", but I haven't found a way to that.
尝试,然后返回一个更具体的问题。我会简单地评论这个问题而不是“回答”,但我还没有找到解决办法。
回答by vishwampandya
I have a sample excel sheet and VBA code corresponding to it . sample excel sheet
我有一个示例 excel 表和与之对应的 VBA 代码。 示例excel表
and here is the corresponding VBA code to convert it into vcf type.
这是将其转换为 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
thankyou, I hope this helps.
谢谢,我希望这会有所帮助。