0

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

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

使用我复杂的翻译代码（见旧帖子），在 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

这里唯一的区别是加载字符串...在这个小代码中，我从直接 Cell 加载文本（仅供尝试），在我的复杂代码中，从.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
4

1 回答 1

0

您的输入文件不是 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

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

于 2017-02-10T14:39:03.160 回答