excel - 将带有UTF-8特殊字符的txt文件导入xlsx

Question

我有从另一个系统自动导出给我的 txt 文件(我无法更改此系统)。当我尝试使用以下代码将这些txt文件转换为excel时(我手动创建了一个子文件夹xlsx):

Sub all()

   Dim sourcepath As String
   Dim sDir As String
   Dim newpath As String
    
    sourcepath = "C:\Users\PC\Desktop\Test\"
    newpath = sourcepath & "xlsx\"
    
    'make sure subfolder xlsx was created before

    sDir = Dir$(sourcepath & "*.txt", vbNormal)
    Do Until Len(sDir) = 0
        Workbooks.Open (sourcepath & sDir)
        With ActiveWorkbook
            .SaveAs Filename:=Replace(Left(.FullName, InStrRev(.FullName, ".")), sourcepath, newpath) & "xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            .Close
        End With
        
        sDir = Dir$
    Loop
End Sub

它确实有效，但是某些特殊字符(例如 ä、ö 和 Ü 等)无法正确显示。 IE。当我稍后打开 xlsx 文件时，我可以看到这些文件已被诸如 ¤ 之类的内容替换。我可以使用变通办法，然后开始替换它们，但是我想将我的 txt 改进为 xlsx 代码。据此post或者这个one使用 ADODB.Stream 应该可以。但是，我不知道如何将其实现到我的代码(循环)中以使其在我的情况下在这里工作？如果有另一种方法代替 ADOB.Stream 我也同意。我没有必要使用 ADOB.Stream。

Answer 1

您是否尝试过使用 Origin 参数强制代码页？我不知道您是否需要特定的常量，但 UTF-8 常量可能是一个起点。我个人喜欢这个页面作为引用来源:https://learn.microsoft.com/en-us/windows/win32/intl/code-page-identifiers

所以解决方案可能会像这样简单 - 它在我的虚拟测试中有效:

Option Explicit
Private Const CP_UTF8 As Long = 65001

Public Sub RunMe()
    Dim sDir As String, sourcePath As String, fileName As String
    Dim fso As Object
    
    sourcePath = "C:\anyoldpath\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    sDir = Dir(sourcePath & "*.txt", vbNormal)
    Do While Len(sDir) > 0
        fileName = sourcePath & "xlsx\" & fso.GetBaseName(sDir) & ".xlsx"
        Application.Workbooks.OpenText sourcePath & sDir, CP_UTF8
        ActiveWorkbook.SaveAs fileName, xlOpenXMLWorkbook
        ActiveWorkbook.Close False
        sDir = Dir()
    Loop
End Sub