vCard æøå bliver til ?

Har du prøvet at bruge utf8 kodning, for at få danske tegn ?
Jeg har prøvet at indsætte "Utf8Encode" til teksten, i koden, herunder, som burde korrigere for danske tegn, men kan ikke teste det her hos mig, da jeg ingen data har ;-)

Sub ExportEachToSeparateVCard_v4()
    Dim ws As Worksheet
    Dim LastRow As Long
    Dim i As Long
    Dim FileNum As Integer
    Dim LogNum As Integer
    Dim vCardText As String
    Dim FilePath As String
    Dim LogPath As String
    Dim SkippedContacts As Long
    Dim SkipReason As String
    Dim DateTimeStamp As String
    Dim FolderPath As String

    ' Fejlhåndtering
    On Error GoTo ErrorHandler

    ' Definer arbejdsarket
    Set ws = ThisWorkbook.Sheets("Ark1") ' Skift "Ark1" til dit ark-navn

    ' Find sidste række med data
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    If LastRow < 2 Then Err.Raise vbObjectError + 1000, , "Ingen kontakter fundet i regnearket."

    ' Tilpas kolonnebredde automatisk
    ws.Cells.EntireColumn.AutoFit

    ' Opret tidsstempel til logfilnavn
    DateTimeStamp = Format(Now, "yyyy-mm-dd_HH-MM-SS")

    ' Find sti til mappen hvor Excel-filen er gemt
    FolderPath = ThisWorkbook.Path
    If FolderPath = "" Then Err.Raise vbObjectError + 1001, , "Excel-filen skal være gemt først."

    ' Sti til logfil
    LogPath = FolderPath & "\vCard_Log_" & DateTimeStamp & ".txt"

    ' Opret logfil
    LogNum = FreeFile
    Open LogPath For Output As #LogNum
    Print #LogNum, "===== VCard Eksport Log ====="
    Print #LogNum, "Dato: " & Now
    Print #LogNum, "--------------------------------------"

    ' Tæller for skippede kontakter
    SkippedContacts = 0

    ' Gennemgå hver række med kontaktinfo
    For i = 2 To LastRow ' Antager række 1 er overskrifter
        SkipReason = ""

        ' Tjek for manglende fornavn eller efternavn
        If ws.Cells(i, 1).Value = "" Then SkipReason = "Fornavn mangler."
        If ws.Cells(i, 3).Value = "" Then SkipReason = "Efternavn mangler."

        ' Hvis der er en fejl, skriv til log og spring over
        If SkipReason <> "" Then
            SkippedContacts = SkippedContacts + 1
            Print #LogNum, "Række " & i & " - " & SkipReason
            GoTo NextContact
        End If

        ' Opret vCard-indhold
        vCardText = "BEGIN:VCARD" & vbCrLf
        vCardText = vCardText & "VERSION:4.0" & vbCrLf
        vCardText = vCardText & "N:" & Utf8Encode(ws.Cells(i, 3).Value) & ";" & Utf8Encode(ws.Cells(i, 1).Value) & ";" & Utf8Encode(ws.Cells(i, 2).Value) & ";;" & vbCrLf
        vCardText = vCardText & "FN:" & Utf8Encode(ws.Cells(i, 1).Value) & " " & Utf8Encode(ws.Cells(i, 2).Value) & " " & Utf8Encode(ws.Cells(i, 3).Value) & vbCrLf

        If ws.Cells(i, 4).Value <> "" Then vCardText = vCardText & "ORG:" & Utf8Encode(ws.Cells(i, 4).Value) & vbCrLf
        If ws.Cells(i, 5).Value <> "" Then vCardText = vCardText & "TITLE:" & Utf8Encode(ws.Cells(i, 5).Value) & vbCrLf
        If ws.Cells(i, 6).Value <> "" Then vCardText = vCardText & "TEL;TYPE=cell:" & Utf8Encode(ws.Cells(i, 6).Value) & vbCrLf
        If ws.Cells(i, 7).Value <> "" Then vCardText = vCardText & "TEL;TYPE=work,voice:" & Utf8Encode(ws.Cells(i, 7).Value) & vbCrLf
        If ws.Cells(i, 8).Value <> "" Then vCardText = vCardText & "TEL;TYPE=home,voice:" & Utf8Encode(ws.Cells(i, 8).Value) & vbCrLf
        If ws.Cells(i, 9).Value <> "" Then vCardText = vCardText & "EMAIL;TYPE=work:" & Utf8Encode(ws.Cells(i, 9).Value) & vbCrLf
        If ws.Cells(i, 10).Value <> "" Then vCardText = vCardText & "EMAIL;TYPE=home:" & Utf8Encode(ws.Cells(i, 10).Value) & vbCrLf

        ' Adresse Arbejde
        If ws.Cells(i, 11).Value <> "" Or ws.Cells(i, 12).Value <> "" Or ws.Cells(i, 13).Value <> "" Or ws.Cells(i, 14).Value <> "" Or ws.Cells(i, 15).Value <> "" Then
            vCardText = vCardText & "ADR;TYPE=work:;;" & Utf8Encode(ws.Cells(i, 11).Value) & "\n" & _
                        Utf8Encode(ws.Cells(i, 12).Value) & " " & Utf8Encode(ws.Cells(i, 13).Value) & " " & Utf8Encode(ws.Cells(i, 14).Value) & "\n" & _
                        Utf8Encode(ws.Cells(i, 15).Value) & vbCrLf
        End If

        ' Adresse Privat
        If ws.Cells(i, 16).Value <> "" Or ws.Cells(i, 17).Value <> "" Or ws.Cells(i, 18).Value <> "" Or ws.Cells(i, 19).Value <> "" Or ws.Cells(i, 20).Value <> "" Then
            vCardText = vCardText & "ADR;TYPE=home:;;" & Utf8Encode(ws.Cells(i, 16).Value) & "\n" & _
                        Utf8Encode(ws.Cells(i, 17).Value) & " " & Utf8Encode(ws.Cells(i, 18).Value) & " " & Utf8Encode(ws.Cells(i, 19).Value) & "\n" & _
                        Utf8Encode(ws.Cells(i, 20).Value) & vbCrLf
        End If

        ' LinkedIn
        If ws.Cells(i, 21).Value <> "" Then vCardText = vCardText & "URL:" & Utf8Encode(ws.Cells(i, 21).Value) & vbCrLf

        vCardText = vCardText & "END:VCARD" & vbCrLf

        ' Opret filnavn og sti til vCard-fil
        FilePath = FolderPath & "\vCard_" & Utf8Encode(ws.Cells(i, 1).Value) & "_" & Utf8Encode(ws.Cells(i, 3).Value) & ".vcf" ' "_" & DateTimeStamp &

        ' Opret vCard-filen
        FileNum = FreeFile
        Open FilePath For Output As #FileNum
        Print #FileNum, vCardText
        Close #FileNum

NextContact:
    Next i

    ' Luk logfil
    Close #LogNum

    ' Bekræftelse til brugeren
    MsgBox "Alle kontakter er gemt som separate vCard-filer i samme mappe som Excel-filen." & vbCrLf & _
          "Logfil med skippede kontakter: '" & LogPath & "'" & vbCrLf & _
          "Kontakter sprunget over pga. manglende data: " & SkippedContacts, vbInformation, "Færdig"

    Exit Sub

ErrorHandler:
    ' Luk filerne sikkert ved fejl
    If FileNum > 0 Then Close #FileNum
    If LogNum > 0 Then Close #LogNum
    MsgBox "Fejl: " & Err.Description & vbCrLf & "Kode: " & Err.Number, vbCritical, "Fejl under eksport"
End Sub

Function Utf8Encode(value As String) As String
    Dim utf8Value As String
    utf8Value = value
    utf8Value = Replace(utf8Value, "æ", "æ")
    utf8Value = Replace(utf8Value, "ø", "ø")
    utf8Value = Replace(utf8Value, "å", "å")
    Utf8Encode = utf8Value
End Function

Hej ebea,

Hvis jeg ligger den ind i et nyt modul som VBA, så ligger den nederste Function Utf8 sig lidt som en ny kode under.
Bliver den så kørt når jeg kører den normale VBA?

Det ændrer i hvert fald ikke noget på min android telefon.
Men som du kan se øverst, så laver den teksten rigtigt i vcard filen, æøå står der fint, når jeg så mailer den til mig selv og importerer den til kontakter i telefonen, så bliver æ,ø og å til ? i firkant som står på spidsen.

#2 - Det med nyt Modul, og så kode under, forstår jeg ikke rigtig hvad du mener med.

At det ikke "slår igennem" på din Android telefon, er nok mere et udtryk for, at den Android version du har på tlf. ikke kan læse karaktersættet fra den genererede fil.

Jeg lavede en søgning på Android, og der kan jeg se, at Android understøtter VCard version 4, som understøtter utf8 kodning. Så ?

Jeg har tidligere anvendt ADODB.Stream-objektet til at læse og skrive UTF-8-filer, når jeg oplevede problemer med karaktersættet. Ved ikke, om det kunne være løsningen her.

Nedenstående grund-kode er foreslået af Microsoft Copilot:
(NB! Jeg har ikke afprøvet koden selv)

Sub SaveAsUTF8()
    Dim fsT As Object
    Dim filePath As String
    Dim textData As String
   
    ' Define the file path and text data
    filePath = "C:\path\to\yourfile.txt"
    textData = "This is a sample text with special characters: äöüß"

    ' Create and configure the ADODB.Stream object
    Set fsT = CreateObject("ADODB.Stream")
    fsT.Type = 2 ' Specify stream type - text
    fsT.Charset = "utf-8" ' Specify charset - UTF-8
    fsT.Open ' Open the stream
    fsT.WriteText textData ' Write the text data to the stream

    ' Save the stream to a file
    fsT.SaveToFile filePath, 2 ' 2 means overwrite if the file exists
    fsT.Close ' Close the stream

    ' Clean up
    Set fsT = Nothing
End Sub

#3,

Ved ikke helt hvad det UTF er, men kan se det er de specielle tegn der bliver importeret med en kode i stedet, hvis jeg har fattet det rigtigt.

Men den vil ikke importere filnen på min telefon, når det er UFT-8.
Hvor den laver æø om til dette: SxF8by xC6rxF8 \nDanmark
                                                  Søby      Ærø

Oneplus 12 telefon

#4,

Det vil jeg lige prøve at arbejde lidt med, men om den ender som svaret til #3 er spændende.

#5 - skal det forståes sådan, at den kode jeg viste, ikke kan generere en VCard fil, som kan læses af din tlf. ?

Jeg har ingen erfaringer med tekstfiler/vCards til telefoner, så det bliver spændende at se :-)

#5 - Har du prøvet, som en test, at importere den genererede VCard fil i Outlook, og se om den viser korrekt tegnsæt ?
Det kunne jo give en ide om, hvor problemet er. Om det er Android, eller andet.

#7,

Jo, den generer filer, men den laver de samme tegn i stedet for æøå.

Jo, kan godt se den kører hele koden 👍
Men samme resultat med æøå.

Spøjst at hvis jeg eksporterer en kontakt fra telefonen til mail og åbner den, så står den sådan her:

BEGIN:VCARD
VERSION:2.1
N;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=41=6D=6D=65=72=73=62=C3=B8=6C=6C;=48=61=6E=73;=48=65=6E=72=69=6B;;
FN;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=48=61=6E=73=20=48=65=6E=72=69=6B=20=41=6D=6D=65=72=73=62=C3=B8=6C=6C=

TEL;WORK:xxxxxxxxxxxx
TEL;HOME:+45xxxxxxxxxxxxxxx
TEL;HOME:xxxxxxxxxxxxxx
EMAIL;PREF;WORK:xxxxxxxxx
EMAIL;HOME:xxxxxxxxxxxxx
ADR;PREF;WORK;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;;=35=20=44=6F=6B=76=65=6A;=53=C3=B8=62=79=20=C3=86=72=C3=B8;;=35=39=38=35;=44=61=6E=6D=61=72=6B
ADR;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:;;=36=20=53=6B=6F=76=76=65=6A=65=6E;=53=C3=B8=62=79=20=C3=86=72=C3=B8;=53=79=64=64=61=6E=6D=61=72=6B;=35=39=38=35;=44=4B
ORG;CHARSET=UTF-8;ENCODING=QUOTED-PRINTABLE:=53=C3=B8=62=79=20=56=C3=A6=72=66=74=20=41=53

Sidste linje betyder koden: Søby Værft AS

Sgu da mærkeligt at det er så lavt et versions nummer 2.1 ???

#9,
Den kan fint importeres til Outlook, med æøå.
Der ser det hele rigtigt ud.

Jeg oploader lige den excel fil jeg arbejder med.
Har lavet 2 moduler ekstra, med koder jeg tester.
Knapperne i arket kører modul 1 og 2.
Test koderne har jeg kørt direkte fra selve kode vinduet.

http://46.32.50.245:8080/share.cgi?ssid=b65d67e3411e45f4bc2a7ecbaa057574&fid=b65d67e3411e45f4bc2a7ecbaa057574
Adgangskode: 2244

#11 - Uden at have testet di kode, tror jeg, at problemet skal findes i din tlf.

I dit åbnings spørgsmål, viser den Version 4, men når du eksporterer, viser den version 2.1

Kunne du prøve, at bruge en 3.die parts App, til at hente en VCard fil ind.