Funktion zum Erzeugen einer gültigen vCard Datei (.vcf)

~ 0 min
15.10.2018 08:28

Beschreibung:
Mit dieser Funktion kann eine gültige vCard-Datei (.vcf) erzeugt werden mit der aus AG-VIP SQL Kontakte in andere Software oder Geräte übertragen werden kann (sofern diese das Format unterstützen).

Hinweis:
Der folgende Makrocode ist in einem Hilfsmittel, einer Schaltfläche, im MakroInclude oder sonstiger Makroausführungsposition z.B. "beim Speichern" möglich.
Es gibt zwei Versionen.
Die Paramater starke, bei der beim Aufruf der Funktion sämtliche Inhalte übergeben werden müssen und die Parameter schwache, bei der alle Inhalte bis auf den Speicherort und Dateinamen aus AG-VIP SQL direkt ermittelt werden.
Der Speicherort und Dateiname wird immer im ersten Parameter in der Variable "strPathFile" angegeben.
Ein Beispiel für den Aufruf der Parameter schwachen Funktion:
MakevCard "C:\Temp\Test.vcf"

Falls das Makro in einem Hilfsmittel mit der Angabe des neuen Dateinamens verwendet werden sollte, kann mit dem Aufruf "ActiveTool.Filename"dieser Pfad direkt ausgelesen werden.
Beispiel:
MakevCard ActiveTool.Filename
 

Parameter starke Makro-Version:
' this Function creates a vCard (.vcf), which can be used to import an contact entry
Function MakevCard( strPathFile, strFirstname, strLastname, strCompany, strStreet, strCity, strZipCode, strCountry, _
                               strTelWork, strTelPrivate, strTelMobil, strTelOther, strTelFax, strEmail1, strEmail2, strEmail3, strWebsite)
     
     Dim strDirectorySeperator, icsFile, fso
    
     set fso = createobject("scripting.filesystemobject")
     set icsFile = fso.createtextfile(strPathFile,true)

     ' fill the file with the icalendar format
     icsFile.writeline("BEGIN:VCARD")
     icsFile.writeline("VERSION:3.0")
     icsFile.writeline("N:" & strLastname & ";" & strFirstname)
     icsFile.writeline("FN:" & strFirstname & " " & strLastname)
     icsFile.writeline("ORG:" & strCompany)
     icsFile.writeline("ADR;TYPE=WORK,POSTAL,PARCEL:;;" & strStreet & ";" & strCity & ";;" & strZipCode & ";" & strCountry)
     icsFile.writeline("TEL;TYPE=VOICE,WORK:" & strTelWork)
     icsFile.writeline("TEL;TYPE=VOICE,HOME:" & strTelPrivate)
     icsFile.writeline("TEL;TYPE=VOICE,CELL:" & strTelMobil)
     icsFile.writeline("TEL;TYPE=VOICE,MSG:" & strTelOther)
     icsFile.writeline("TEL;TYPE=FAX,WORK:" & strTelFax)
     icsFile.writeline("EMAIL;TYPE=INTERNET,PREF:" & strEmail1)
     icsFile.writeline("EMAIL;TYPE=INTERNET:" & strEmail2)
     icsFile.writeline("EMAIL;TYPE=INTERNET:" & strEmail3)
     icsFile.writeline("URL:" & strWebsite)
     icsFile.writeline("END:VCARD")

     set fso = nothing
End Function

Parameter schwache Makro-Version:

' this Function creates a vCard (.vcf), which can be used to import an contact entry
vPfad = "C:\temp\" & ActiveRecord.Fields("ShortName").Value & ".vcf"

' Falls der Ablagepfad nach Erzeugen angezeigt werden soll, nachfolgende Zeile aktivieren
' Macro.Clipboard = vPfad
' msgbox "Der Pfad zur vCard: " & vPfad & " kann über die Tastenkombination STRG & V eingefügt werden."

MakevCard vPfad

Function MakevCard(strPathFile)
Dim strFirstname, strLastname, strCompany, strStreet, strCity, strZipCode, strCountry, strFunction
Dim strTelWork, strTelPrivate, strTelMobil, strTelOther, strTelFax, strEmail1, strEmail2, strEmail3, strWebsite

strFunction = ActiveAddress.Fields("Function").value
strFirstname = ActiveAddress.Fields("NameFirst").value
strLastname = ActiveAddress.Fields("NameLast").value
strCompany = ActiveAddress.Fields("Name1").value
strStreet = ActiveAddress.Fields("Street").value
strCity = ActiveAddress.Fields("City").value
strZipCode = ActiveAddress.Fields("ZipCode").value
strCountry = ActiveAddress.Fields("Country").value
strTelWork = ActiveAddress.Fields("CommPhoneOffice").value
strTelPrivate = ActiveRecord.Fields("CommPhonePrivat").Value
strTelMobil = ActiveAddress.Fields("CommPhoneMobil").value
strTelOther = ActiveAddress.Fields("CommPhone1").value
strTelFax = ActiveAddress.Fields("CommFaxOffice").value
strEmail1 = ActiveAddress.Fields("CommEmail1").value
strEmail2 = ActiveAddress.Fields("CommEmail2").value
strEmail3 = ActiveAddress.Fields("CommEmail3").value
strWebsite = ActiveRecord.Fields("CommInternet").Value

Dim strDirectorySeperator, icsFile, fso

set fso = createobject("scripting.filesystemobject")
set icsFile = fso.createtextfile(strPathFile,true)

' fill the file with the icalendar format
icsFile.writeline("BEGIN:VCARD")
icsFile.writeline("VERSION:3.0")
icsFile.writeline("N:" & strLastname & ";" & strFirstname)
icsFile.writeline("FN:" & strFirstname & " " & strLastname)
icsFile.writeline("ORG:" & strCompany)
icsFile.writeline("TITLE:" & strFunction)
icsFile.writeline("ADR;TYPE=WORK,POSTAL,PARCEL:;;" & strStreet & ";" & strCity & ";;" & strZipCode & ";" & strCountry)
icsFile.writeline("TEL;TYPE=VOICE,WORK:" & strTelWork)
icsFile.writeline("TEL;TYPE=VOICE,HOME:" & strTelPrivate)
icsFile.writeline("TEL;TYPE=VOICE,CELL:" & strTelMobil)
icsFile.writeline("TEL;TYPE=VOICE,MSG:" & strTelOther)
icsFile.writeline("TEL;TYPE=FAX,WORK:" & strTelFax)
icsFile.writeline("EMAIL;TYPE=INTERNET,PREF:" & strEmail1)
icsFile.writeline("EMAIL;TYPE=INTERNET:" & strEmail2)
icsFile.writeline("EMAIL;TYPE=INTERNET:" & strEmail3)
icsFile.writeline("URL;WORK:" & strWebsite)
icsFile.writeline("END:VCARD")

set fso = nothing
End Function

Einbindung:
Kopieren Sie einer der beiden Makro-Versionen an die von Ihnen gewünschte Position (Hilfsmittel, Schaltfläche, MakroInclude etc.).
Falls beide Versionen eingesetzt werden sollten, muss zuvor bei einer der Funktionen der Funktionsname geändert werden, da diese momentan identisch sind.
Der Aufruf erfolgt über den Funktionsnamen und der Übergabe der Werte an die Parameter der Funktion wie in dem kleinen Beispiel im Punkt Hinweis ersichtlich.

 

Angehängte Dateien:

Durchschnittliche Bewertung 0 (0 Abstimmungen)

Kommentieren nicht möglich