' Script conversione automatica rubrica contatti Kataweb formato LDIF -> VCARD ' versione 1.0, 28/09/2013 ' Michele Nasi, www.ilsoftware.it Function CountOccurrences(p_strStringToCheck, p_strSubString, p_boolCaseSensitive) Dim arrstrTemp Dim strBase, strToFind If p_boolCaseSensitive Then strBase = p_strStringToCheck strToFind = p_strSubString Else strBase = LCase(p_strStringToCheck) strToFind = LCase(p_strSubString) End If arrstrTemp = Split(strBase, strToFind) CountOccurrences = UBound(arrstrTemp) End Function Set fso = CreateObject("Scripting.FileSystemObject") Set ldif = fso.OpenTextFile("kata.ldif") Set vcard = fso.CreateTextFile("kata.vcf",True) Dim mail Dim cognome_nome mail="" cognome_nome="" do while not ldif.AtEndOfStream stringa = ldif.ReadLine() if instr(stringa,"x-version:")>0 then vcard.Write "BEGIN:VCARD"&vbcrlf&"VERSION:2.1"&vbcrlf if instr(stringa,"x-firstname_ABContact:")>0 then if cognome_nome="" then cognome_nome=cognome_nome&" "&mid(stringa,(len("x-firstname_ABContact:")+2)) else cognome_nome=mid(stringa,(len("x-firstname_ABContact:")+2)) end if end if if instr(stringa,"x-lastname_ABContact:")>0 then stringa=mid(stringa,(len("x-lastname_ABContact:")+2)) cognome_nome=cognome_nome&" "&stringa cognome_nome=replace(cognome_nome," ",";") c=CountOccurrences(cognome_nome,";",false) for i=1 to 4-c cognome_nome=cognome_nome&";" next vcard.Write "N:"&cognome_nome&vbcrlf vcard.Write "FN:"&stringa&vbcrlf end if if instr(stringa,"telephoneNumber:")>0 and instr(stringa,"facsimiletelephonenumber:")=0 then stringa=mid(stringa,(len("telephoneNumber:")+2)) if left(stringa,1)="3" then stringa="TEL;CELL:"&stringa else stringa="TEL;WORK:"&stringa end if vcard.Write stringa&vbcrlf end if if instr(stringa,"facsimiletelephonenumber:")>0 then stringa=mid(stringa,(len("facsimiletelephonenumber:")+2)) vcard.Write "TEL;WORK;FAX:"&stringa&vbcrlf end if if instr(stringa,"mail:")>0 and instr(stringa,".mail:")=0 then stringa=mid(stringa,(len("mail:")+2)) if stringa<>mail then vcard.Write "EMAIL;WORK:"&stringa&vbcrlf mail=stringa end if if stringa="" then vcard.Write "END:VCARD"&vbcrlf loop vcard.Close ldif.Close Set vcard = Nothing Set ldif = Nothing