法语单词的 Excel 到 XML 编码问题

Question

我已经在这里找到了部分解决方案来解决我用一些法语单词进行编码的问题...

但是！很少有角色在做问题，我不知道为什么。我尝试使用单独的 VBA 脚本直接用这些字符复制这个有问题的单词，这没问题，这对我来说真的很神秘！

使用我复杂的翻译代码 (see old post)，在 excel 表中我有 Français 而在 XML 中则错误的表示 Français

可以正常工作的代码

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

确保在读写时始终使用正确的编码。