Discussion :

[luckycky]

Bonjour,

J'ai une macro qui me permet d'enregistrer des VCARD (.vcf), mais mon encodage n'est pas bon, je souhaiterai encoder en UTF-8 pour ne pas avoir de problème d'accent mais impossible.
Est ce que quelqu'un a une solution?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Sub Ecrire_vCard(i As Integer)
Dim Nom As String, Prénom As String
Dim Adr_pro As String, CP_pro As String, Ville_pro As String
Dim Contenu As String, SousRep As String, Ndf As String
 
    Contenu = ""
 
    Nom = UCase(Range("C" & i).Value)
    Adr_pro = Range("J" & i).Value & " " & Range("K" & i).Value & " " & Range("L" & i).Value
    CP_pro = Range("M" & i).Value
    Ville_pro = Range("N" & i).Value
 
 
    Contenu = Contenu & "BEGIN:VCARD" & vbCrLf _
            & "VERSION:3.0" & vbCrLf _
            & "N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:" & Nom & ";" & Prénom & ";;" & Range("B" & i).Value & vbCrLf _
            & "FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:" & Range("B" & i).Value & " " & Nom & vbCrLf _
            & "ORG:" & Range("A" & i).Value & vbCrLf _
            & "TITLE;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE: " & Range("D" & i).Value & Range("E" & i).Value & vbCrLf _
            & "item1.TEL;type=pref;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:" & Range("F" & i).Value & vbCrLf _
            & "TEL;type=CELL;type=VOICE;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:" & Range("G" & i).Value & vbCrLf _
            & "EMAIL;type=INTERNET;type=HOME;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:type=pref:" & Range("H" & i).Value & vbCrLf _
            & "item2.ADR;type=HOME;type=pref;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;;" & Adr_pro & ";" & Ville_pro & ";;" & CP_pro & vbCrLf _
            & "NOTE:" & Range("O" & i).Value & vbCrLf _
            & "END:VCARD" & vbCrLf
 
    SousRep = ThisWorkbook.Path & "\Dossier_vCard"
    If Not ExisteRep(SousRep) Then MkDir (SousRep)
    Ndf = Nom & "_" & Prénom & ".vcf"
    On Error Resume Next
    Open SousRep & "\" & Ndf For Output As #1
    Print #1, Contenu
    Close #1
End Sub

Merci d'avance,
Bien à vous

[Thumb down]

https://www.developpez.net/forums/d1...a/#post8212249