Programmatically export Lotus Notes contacts to VCard format

Lotus Notes 6 makes it possible to export contacts to VCard format. You can do it using File-Export menu. In the Export dialog box you can choose to export to VCard 2.1/3.0 format. After that you can import the resulting VCF file into Outlook.

But sometimes you would like to modify the format which the automated function uses. For example instead of "FirstName LastName/Company/Country" format in VCard's FN field you want to use simply "FirstName LastName", or you want to make a lookup to fetch the required field value.
"Export to VCard" option is available only in the databases of type "Domino Directory", you can not see that export option in regular Domino databases where you might have people documents.

Here is a LotusScript agent which runs on selected documents in any database and exports them to VCard fromat. The agent expects that the names of the fields in the documents are the same as in Address Book's "Person" form, so if you used other field names you must modify the agent. The agent's "Target" property is "All selected documents". Agent is run by choosing agent's name in the actions menu in a view after you've selected the documents you want to export.


'------------- AGENT START -----------
Sub Initialize
Dim session As New NotesSession
Dim nabdb As NotesDatabase
Dim nabdoc As NotesDocument
Dim nabcoll As NotesDocumentCollection
Dim vcardfile As String
Dim result As String
Dim linebreak As String
Dim fileNum As Integer

linebreak=Chr(13)+Chr(10)
vcardfile="c:\lotus_notes_contacts.vcf"

Set nabdb=session.CurrentDatabase
Set nabcoll=nabdb.UnprocessedDocuments
Print "Exporting"+Cstr(nabcoll.Count)+" documents to VCard "+vcardfile

If nabcoll.Count=0 Then Exit Sub

fileNum% = Freefile()
Open vcardfile For Output As #fileNum%

Set nabdoc=nabcoll.GetFirstDocument
While Not nabdoc Is Nothing

result="BEGIN:VCARD"+linebreak+ "VERSION:2.1"

result=result+linebreak+ "N:"+nabdoc.LastName(0)+";"+nabdoc.FirstName(0)+";"+nabdoc.MiddleName(0)+";"+nabdoc.Title(0)
If nabdoc.MiddleName(0)="" Then
FullName=nabdoc.FirstName(0)+" "+nabdoc.LastName(0)
Else
FullName=nabdoc.FirstName(0)+" "+nabdoc.MiddleName(0)+" "+nabdoc.LastName(0)
End If
result=result+linebreak+"FN:"+FullName
' result=result+linebreak+"NICKNAME:"+FullName
result=result+linebreak+"ORG:"+nabdoc.CompanyName(0)+";"+nabdoc.Department(0)
result=result+linebreak+"TITLE:"+nabdoc.JobTitle(0)
result=result+linebreak+"NOTE:"+nabdoc.Comment(0)
result=result+linebreak+"TEL;WORK;VOICE:"+nabdoc.OfficePhoneNumber(0)
result=result+linebreak+"TEL;HOME;VOICE:"+nabdoc.PhoneNumber(0)
result=result+linebreak+"TEL;CELL;VOICE:"+nabdoc.CellPhoneNumber(0)
result=result+linebreak+"TEL;WORK;FAX:"+nabdoc.OfficeFaxPhoneNumber(0)
result=result+linebreak+"TEL;HOME;FAX:"+nabdoc.HomeFAXPhoneNumber(0)
result=result+linebreak+"ADR;WORK:;"+nabdoc.OfficeCity(0)+";"+replaceLineBreak(nabdoc.OfficeStreetAddress(0))+";"+nabdoc.OfficeCity(0)+";"+nabdoc.OfficeState(0)+";"+nabdoc.OfficeZIP(0)+";"+nabdoc.OfficeCountry(0)
result=result+linebreak+"ADR;HOME:;;"+replaceLineBreak(nabdoc.StreetAddress(0))+";"+nabdoc.City(0)+";"+nabdoc.State(0)+";"+nabdoc.Zip(0)+";"+nabdoc.Country(0)
' result=result+linebreak+"URL;WORK:"+nabdoc.WebSite(0)
result=result+linebreak+"URL;HOME:"+nabdoc.WebSite(0)
result=result+linebreak+"PREF;INTERNET:"+nabdoc.InternetAddress(0)
result=result+linebreak+"EMAIL;INTERNET:"+nabdoc.MailAddress(0)

result=result+linebreak+"END:VCARD"

Print #fileNum%, result

Set nabdoc=nabcoll.GetNextDocument(nabdoc)
Wend

Close #fileNum%

End Sub


Function replaceLineBreak(oldString)
replaceFrom=Chr(13)+Chr(10)
replaceTo=", "
tmpString = Evaluate(|@ReplaceSubstring("| + oldString + |"; "|+replaceFrom+|"; "|+replaceTo+|")|)
replaceLineBreak=tmpString(0)
End Function

'------------- AGENT END -----------


Technorati: Show-n-Tell Thursday LotusScript VCard