Проблемы с кодировкой Excel в XML с французскими словами

Question

Я уже нашел частичное решение здесь для моей проблемы с кодированием с некоторыми французскими словами...

Тем не мение! Немного персонажей делают проблемы, и я не могу понять, почему. Я пытался сделать отдельный скрипт VBA для прямого копирования этого проблемного слова с этими символами, и это было нормально, что для меня загадка!

С моим сложным кодом перевода ( см. Старый пост), в листе Excel у меня есть Français и в XML, тогда неправильное представление Françaais

КОД, который работает нормально

Sub EncodingRepair()

Dim strLine As String
Dim strPath As String

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

Dim strFolderPath As String

strFolderPath = "C:\Users\zema\Documents\"

Set fOutputFile = fso.CreateTextFile(strFolderPath & "EncodingRepair.xml", True)

strLine = ThisWorkbook.Worksheets("wording").Range("G16").Text

fOutputFile.WriteLine (strLine & vbCrLn)

End Sub

Единственная разница здесь - загрузка строки... В этом небольшом коде я загружаю текст из прямой ячейки (только для попытки), а в моем сложном коде происходит загрузка из объекта .Range, куда я положил искомый.Row

Сложный код, где у меня проблемы с последними словами

If intChoice <> 0 Then

strPath = Application.FileDialog( _
msoFileDialogOpen).SelectedItems(1)

Dim strFolderPath As String

strFolderPath = Left(strPath, Len(strPath) - 4)
Set fGermanOutputFile = fso.CreateTextFile((strFolderPath & "_German.xml"), True, True)
Set fItalianOutputFile = fso.CreateTextFile((strFolderPath & "_Italian.xml"), True, True)
Set fFrenchOutputFile = fso.CreateTextFile((strFolderPath & "_French.xml"), True, True)

Open strPath For Input As #1

AlarmString = "RESETNoTranslation"

Do Until EOF(1)
    Line Input #1, strLine

    AllLine = strLine

    Alarm = InStr(1, strLine, AlarmString)

    intLastFoundChar = 0

    strGermanLine = ""
    strFrenchLine = ""
    strItalianLine = ""

    For intI = 0 To (UBound(ArrStrOpeningTags, 1) - 1)

        intFoundString = InStr(strLine, ArrStrOpeningTags(intI))

        If intFoundString <> 0 Then
            intI = 4
        End If

    Next intI

    If ((intFoundString <> 0) And (Alarm = 0)) Then

        For intJ = 0 To (UBound(ArrStrParamsToReplace) - 1)


            strLine = Right(strLine, Len(strLine) - intLastFoundChar)

            strStringToLookFor = (ArrStrParamsToReplace(intJ) & "=""")

            intFoundString = InStr(1, strLine, strStringToLookFor, vbBinaryCompare)

            If intFoundString <> 0 Then
                intStringSplitIndex = (intFoundString + Len(strStringToLookFor))

                strStringToLookFor = Right(strLine, Len(strLine) - intStringSplitIndex + 1)

                strDummyString = Left(strLine, intStringSplitIndex - 1)
                strGermanLine = strGermanLine & strDummyString
                strFrenchLine = strFrenchLine & strDummyString
                strItalianLine = strItalianLine & strDummyString

                intLastFoundChar = intLastFoundChar + intStringSplitIndex

                intFoundString = InStr(strStringToLookFor, """")

                If intFoundString <> 0  strStringToLookFor = Left(strStringToLookFor, intFoundString - 1)

                    Set rngFoundString = rngEnglishDictionary.Find(strStringToLookFor)


                    If (rngFoundString Is Nothing) Then
                        Debug.Print "String " & strStringToLookFor & " not found!"

                        strGermanLine = strGermanLine & strStringToLookFor & """"
                        strFrenchLine = strFrenchLine & strStringToLookFor & """"
                        strItalianLine = strItalianLine & strStringToLookFor & """"
                    Else

                        intWordToReplaceIndex = rngEnglishDictionary.Find(strStringToLookFor).Row - rngEnglishDictionary.Row + 1


                        strGermanLine = strGermanLine & rngGermanDictionary(intWordToReplaceIndex) & """"
                        strFrenchLine = strFrenchLine & rngFrenchDictionary(intWordToReplaceIndex) & """"
                        strItalianLine = strItalianLine & rngItalianDictionary(intWordToReplaceIndex) & """"
                    End If

                    intLastFoundChar = intLastFoundChar + Len(strStringToLookFor)

                End If
            End If

        Next intJ

        If intJ = 2 Then
            strEndOfLine = Right(AllLine, Len(AllLine) - intLastFoundChar)
            strGermanLine = strGermanLine & strEndOfLine
            strFrenchLine = strFrenchLine & strEndOfLine
            strItalianLine = strItalianLine & strEndOfLine
        End If

    Else

    strGermanLine = strLine
    strFrenchLine = strLine
    strItalianLine = strLine

    End If

    fGermanOutputFile.WriteLine (strGermanLine & vbCrLn)
    fFrenchOutputFile.WriteLine (strFrenchLine & vbCrLn)
    fItalianOutputFile.WriteLine (strItalianLine & vbCrLn)

    strGermanLine = ""
    strFrenchLine = ""
    strItalianLine = ""

Loop

End If   
End Sub

Answer 1

Ваш входной файл не Unicode, а UTF-8, поэтому fso TextStream Подход не будет работать для чтения, так как FileSystemObject знает только ASCII и Unicode, а не Utf-8. Для последнего вам нужна ссылка на объекты данных Microsoft ActiveX и ADODB.Stream.

Вот пример, который вы можете построить вокруг своего кода, который использует UTF-8 в качестве входной кодировки и записывает Unicode в файл "EncodingRepair.xml":

Sub EncodingRepair()

Dim strPath As String

Dim fso As Object, inFile As Object
Dim fOutputFile As Object, AllLine As String
Dim LineArray As Variant
Dim strFolderPath As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set inFile = CreateObject("ADODB.Stream")

strFolderPath = "C:\Users\zema\Documents\"
strPath = "C:\00_Tools\test\test.txt"

Set fOutputFile = fso.CreateTextFile("C:\00_Tools\test\EncodingRepair.xml", True, True)

Set inFile = CreateObject("ADODB.Stream")
inFile.Charset = "utf-8"
inFile.Open
inFile.LoadFromFile (strPath)

AlarmString = "RESETNoTranslation"

While Not inFile.EOS
    alltext = inFile.ReadText
    LineArray = Split(alltext, vbCrLf)
    For i = 0 To UBound(LineArray)
        AllLine = LineArray(i)
        'do your magic
        fOutputFile.WriteLine AllLine
    Next i
Wend

End Sub

Обязательно всегда используйте правильную кодировку как при чтении, так и при записи.