Excelbestand naar VCARD converteren voor telefooncentrale

[Gert Bouwmeeste]

Wij hebben een nieuwe telefooncentrale (Siemens Gigaset DX800A) die gekoppeld is aan de PC.

Op zich kun je de contacten uit Oulook (2003) synchroniseren met de telefooncentrale. Dat werkt wel, maar is voor ons niet helemaal voldoende. Wij hebben nl meerdere handsets waarvan er 2 voor privé en 2 voor bedrijf gebruikt worden. In beide handsets moeten verschillende telefoonlijsten gebruikt kunnen worden.

Om het een klein beetje synchroon te houden zoek ik een mogelijkheid om vanuit Excel zgn Vcards in TXT formaat aan te maken. Bedoeling is dat ik uit het hoofdbestand de namen+telefoonnummers filter die naar de INT 1 en de INT 2 moeten (bedrijf) en die welke naar de INT 3 en INT 4 (privé) moeten.

In bijgaand voorbeeldbestand staan op het tabblad Contactpersonen de voorbeelden uit het totaalbestand, op de tabbladen INT 1 2 resp INT 3 4 staat de layout van de Vcards (TXT-formaat) die moeten worden aangemaakt. Dus telkens 7 regels per record (regel) van het tabblad Contactpersonen.

Ik zoek een macro die voor mij doet:
a) filteren op het toaalblad op basis van INT 1 2 of INT 3 4
b) van de gevonden records op het andere tabblad (resp INT 1 2 of INT 3 4) per gevonden record een Vcard aanmaakt in het juiste formaat
c) Het betreffende tabblad (resp INT 1 2 of INT 3 4) opslaat in de map M:\DATA\Telefoon in TXT-formaat met als bestandsnaam <datum vandaag>Contactpersonen INT12.vcf"

Wie heeft er een idee / kan mij helpen?

 

[Gert Bouwmeeste]

Opgelost

Vraag is opgelost. Met een stukje "ouderwetse BASIC" wordt nu vanuit Excel rechtstreeks een TXT-file aangemaakt met de nodige regels en parameters.

Nog ff wat verfijnen en dan zijn we weer klaar

Sub VCardBestandMaken()
Selectie = "INT 3 4"    'Hier nog een keuze voor laten maken in de macro
Filenaam = CStr(Year(Date)) + "-" + CStr(Month(Date)) + "-" + CStr(Day(Date)) + " Vcards voor " + Selectie + ".vcf"
 Open "<doelmap>\" + Filenaam For Output As #1
 
    Range("A2").Select
    
    For Verwerken = 1 To 8     'Dit moet nog aangepast worden naar aantal regels in gebruik
        Voornaam = ActiveCell.Offset(0, 0).Range("A1").Value
        Middelnaam = ActiveCell.Offset(0, 1).Range("A1").Value
        Achternaam = ActiveCell.Offset(0, 2).Range("A1").Value
        TelThuis = ActiveCell.Offset(0, 10).Range("A1").Value
        TelMobiel = ActiveCell.Offset(0, 12).Range("A1").Value
        Categorie = ActiveCell.Offset(0, 13).Range("A1").Value
        If Categorie = Selectie Then
            Print #1, "BEGIN:VCARD"
            Print #1, "VERSION:2.1"
            If Middelnaam <> "" Then
                Print #1, "N:" + Achternaam + ", " + Voornaam + " " + Middelnaam
            Else
                Print #1, "N:" + Achternaam + ", " + Voornaam
            End If
            Print #1, "TEL;HOME;VOICE:" + TelThuis
            Print #1, "TEL;CELL;VOICE:" + TelMobiel
            Print #1, "END:VCARD"
        End If
        ActiveCell.Offset(1, 0).Range("A1").Select 
    Next
Close #1
End Sub