Bonjour à tous,
J’ai un fichier contacts.vcf issu d’une sauvegarde de mon smartphone, je voudrais savoir s’il existe une macro vba qui permet :
d’extraire les différents champs de chacun des contacts,
inscrire dans un fichier Excel ces champs devenant des titres de colonne,
chaque contact occupant une ligne unique avec les données lues dans le fichier vcf
La règle c’est que chaque contact est borné par « BEGIN:VCARD » et « END:VCARD »
Difficulté :
Il peut y avoir un nombre de champ différent pour chaque contact, par exemple plusieurs n° de téléphone, des adresses mail, des notes personnelles, etc.
J’imaginais qu’un contributeur aurait pu être confronté à ce genre de besoin et l’aurait résolu.
En tout cas merci pour une éventuelle piste.
Francois
Dedans il y a du Quoted-printable à traduire en texte compréhensible, il y a également des photos jpeg codée, ne pas en tenir compte dans le fichier excel converti.
'VBScript QuotedPrintableDecode decoding Function for English and Greek characters
'26/11/2016 by gvp
Public Function QuotedPrintableDecode(SourceData)
Dim str_ As String
Dim len_ As Integer
'remove "=" and ";" from SourceData
SourceData = Replace(SourceData, "=", "")
SourceData = Replace(SourceData, ";", "")
'calculate length
len_ = Len(SourceData)
'set string ="" and flag
str_ = ""
'check characters step=2
For i = 0 To (len_ / 2 - 1)
x = Mid(SourceData, 1 + 2 * i, 2)
'greek characters
If x = "CE" Or x = "CF" Then
x = Mid(SourceData, 1 + 2 * i, 4)
If x = "CE91" Then g = "Á"
If x = "CE92" Then g = "Â"
If x = "CE93" Then g = "Ã"
If x = "CE94" Then g = "Ä"
If x = "CE95" Then g = "Å"
If x = "CE96" Then g = "Æ"
If x = "CE97" Then g = "Ç"
If x = "CE98" Then g = "È"
If x = "CE99" Then g = "É"
If x = "CE9A" Then g = "Ê"
If x = "CE9B" Then g = "Ë"
If x = "CE9C" Then g = "Ì"
If x = "CE9D" Then g = "Í"
If x = "CE9E" Then g = "Î"
If x = "CE9F" Then g = "Ï"
If x = "CEA0" Then g = "Ð"
If x = "CEA1" Then g = "Ñ"
If x = "CEA3" Then g = "Ó"
If x = "CEA4" Then g = "Ô"
If x = "CEA5" Then g = "Õ"
If x = "CEA6" Then g = "Ö"
If x = "CEA7" Then g = "×"
If x = "CEA8" Then g = "Ø"
If x = "CEA9" Then g = "Ù"
If x = "CEB1" Then g = "á"
If x = "CEB2" Then g = "â"
If x = "CEB3" Then g = "ã"
If x = "CEB4" Then g = "ä"
If x = "CEB5" Then g = "å"
If x = "CEB6" Then g = "æ"
If x = "CEB7" Then g = "ç"
If x = "CEB8" Then g = "è"
If x = "CEB9" Then g = "é"
If x = "CEBA" Then g = "ê"
If x = "CEBB" Then g = "ë"
If x = "CEBC" Then g = "ì"
If x = "CEBD" Then g = "í"
If x = "CEBE" Then g = "î"
If x = "CEBF" Then g = "ï"
If x = "CF80" Then g = "ð"
If x = "CF81" Then g = "ñ"
If x = "CF83" Then g = "ó"
If x = "CF82" Then g = "ò"
If x = "CF84" Then g = "ô"
If x = "CF85" Then g = "õ"
If x = "CF86" Then g = "ö"
If x = "CF87" Then g = "÷"
If x = "CF88" Then g = "ø"
If x = "CF89" Then g = "ù"
If x = "CEAC" Then g = "Ü"
If x = "CEAD" Then g = "Ý"
If x = "CEAE" Then g = "Þ"
If x = "CEAF" Then g = "ß"
If x = "CF8C" Then g = "ü"
If x = "CF8D" Then g = "ý"
If x = "CF8E" Then g = "þ"
If x = "CEB0" Then g = "à"
If x = "CE90" Then g = "À"
If x = "CE86" Then g = "¢"
If x = "CE88" Then g = "¸"
If x = "CE89" Then g = "¹"
If x = "CE8A" Then g = "º"
If x = "CE8C" Then g = "¼"
If x = "CE8E" Then g = "¾"
If x = "CE8F" Then g = "¿"
i = i + 1
GoTo 10:
End If
'english characters
If Left(x, 1) = "4" Or Left(x, 1) = "5" Or Left(x, 1) = "6" Or Left(x, 1) = "7" Then
If x = "41" Then g = "A"
If x = "42" Then g = "B"
If x = "43" Then g = "C"
If x = "44" Then g = "D"
If x = "45" Then g = "E"
If x = "46" Then g = "F"
If x = "47" Then g = "G"
If x = "48" Then g = "H"
If x = "49" Then g = "I"
If x = "4A" Then g = "J"
If x = "4B" Then g = "K"
If x = "4C" Then g = "L"
If x = "4D" Then g = "M"
If x = "4E" Then g = "N"
If x = "4F" Then g = "O"
If x = "50" Then g = "P"
If x = "51" Then g = "Q"
If x = "52" Then g = "R"
If x = "53" Then g = "S"
If x = "54" Then g = "T"
If x = "55" Then g = "U"
If x = "56" Then g = "V"
If x = "57" Then g = "W"
If x = "58" Then g = "X"
If x = "59" Then g = "Y"
If x = "5A" Then g = "Z"
If x = "61" Then g = "a"
If x = "62" Then g = "b"
If x = "63" Then g = "c"
If x = "64" Then g = "d"
If x = "65" Then g = "e"
If x = "66" Then g = "f"
If x = "67" Then g = "g"
If x = "68" Then g = "h"
If x = "69" Then g = "i"
If x = "6A" Then g = "j"
If x = "6B" Then g = "k"
If x = "6C" Then g = "l"
If x = "6D" Then g = "m"
If x = "6E" Then g = "n"
If x = "6F" Then g = "o"
If x = "70" Then g = "p"
If x = "71" Then g = "q"
If x = "72" Then g = "r"
If x = "73" Then g = "s"
If x = "74" Then g = "t"
If x = "75" Then g = "u"
If x = "76" Then g = "v"
If x = "77" Then g = "w"
If x = "78" Then g = "x"
If x = "79" Then g = "y"
If x = "7A" Then g = "z"
GoTo 10:
End If
'comma space dot etc
If Left(x, 1) = "2" Then
If x = "2E" Then g = "."
If x = "20" Then g = " "
If x = "2C" Then g = ","
If x = "21" Then g = "!"
If x = "2D" Then g = "-"
GoTo 10:
End If
'numbers
If Left(x, 1) = "3" Then
If x = "30" Then g = "0"
If x = "31" Then g = "1"
If x = "32" Then g = "2"
If x = "33" Then g = "3"
If x = "34" Then g = "4"
If x = "35" Then g = "5"
If x = "36" Then g = "6"
If x = "37" Then g = "7"
If x = "38" Then g = "8"
If x = "39" Then g = "9"
GoTo 10:
End If
If fla_ = 0 Then
MsgBox ("At least one unknown character found with UTF-8 Code = " & Mid(SourceData, 1 + 2 * i, 4))
fla_ = 1
End If
10:
str_ = str_ & g
Next i
'DecodedString = str_
QuotedPrintableDecode = str_
End Function
Bonjour,
Merci pour votre investissement, en revanche je dois atteindre mon point de Peters ;(
Comment mettre en oeuvre cette fonction ?
J’ai essayé de créer un nouvelle macro que j’ai appelée « Sub Quoted », en copiant/collant la fonction ci-dessus entre les bornes « Sub Quoted() » et « End Sub » j’obtiens une erreur Erreur de compilation End Sub attendu avec la ligne « '26/11/2016 by gvp » surlignée.
Je dois faire une grossière erreur pour que ça bugge.
