Excel VBA实现文件转UTF-8编码CSV宏异常问题求助

• 初始CSV导出使用VBA原生Open For Output语法，默认输出为当前系统ANSI编码，特殊字符在导出阶段就可能出现丢失，后续转码也无法恢复
• 第一个转码宏存在变量错误：最终保存文件时调用了未声明的FName变量，而非传入的输出路径参数fileToSavePath，同时将ANSI编码的源文件直接以UTF-8编码加载，必然出现字符乱码替换
• 第二个转码宏编码适配错误：简体中文系统默认ANSI编码为GBK/GB2312，而非代码中指定的iso-8859-1，导致转码逻辑未生效，输出仍为ANSI编码

无需拆分「导出ANSI CSV+二次转码」两个步骤，可直接在导出阶段就生成UTF-8无BOM格式的CSV文件，完整代码如下：

1. 文件选择函数（原有逻辑可保留） #

Function FileSelected() As String
    'Function to Open a file
    Dim fd As Office.FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
       .Filters.Clear
       .Filters.Add "Excel Files", "*.xls;*.xlsx;*.xlsm;*.xlsb", 1
       .Title = "Choose an Excel file"
       .AllowMultiSelect = False
       If .Show = True Then
           FileSelected = .SelectedItems(1)
       End If
    End With
End Function

2. 直接导出UTF-8无BOM CSV函数 #

Function CSVConverted(fileToConvert As String) As String
    Const adTypeText = 2
    Const adTypeBinary = 1
    Const adModeReadWrite = 3
    Const adSaveCreateOverWrite = 2
    
    Dim convertedFile As String
    Dim Rows As Long, Cols As Long
    Dim J As Long, K As Long
    Dim sTemp As String, sSep As String
    Dim wb As Workbook, ws As Worksheet
    Dim utfStream As Object, binaryStream As Object

    ' 可自定义分隔符
    sSep = ";!@#;"
    
    Set wb = Workbooks.Open(fileToConvert)
    Set ws = wb.Sheets(1)
    
    ' 生成输出文件路径
    convertedFile = Mid(fileToConvert, 1, InStrRev(fileToConvert, ".")) & "csv"
    
    ' 初始化UTF-8流
    Set utfStream = CreateObject("ADODB.Stream")
    With utfStream
        .Type = adTypeText
        .Charset = "UTF-8"
        .Mode = adModeReadWrite
        .Open
    End With
    
    ' 写入CSV内容到UTF-8流
    With ws
        Rows = .Cells(.Rows.Count, "J").End(xlUp).Row
        For J = 1 To Rows
            sTemp = ""
            Cols = .Cells(J, .Columns.Count).End(xlToLeft).Column
            For K = 1 To Cols
                sTemp = sTemp & .Cells(J, K).Value
                If K < Cols Then sTemp = sTemp & sSep
            Next
            utfStream.WriteText sTemp, 1 ' 1代表写入时加换行符
        Next J
    End With
    wb.Close SaveChanges:=False
    
    ' 跳过UTF-8 BOM头（前3字节），写入二进制流实现无BOM输出
    Set binaryStream = CreateObject("ADODB.Stream")
    With binaryStream
        .Type = adTypeBinary
        .Mode = adModeReadWrite
        .Open
    End With
    
    utfStream.Position = 3
    utfStream.CopyTo binaryStream
    utfStream.Close
    
    ' 保存最终文件
    binaryStream.SaveToFile convertedFile, adSaveCreateOverWrite
    binaryStream.Close
    
    MsgBox "导出完成，共" & Rows & "行数据，文件路径：" & vbCrLf & convertedFile
    CSVConverted = convertedFile
End Function

3. 调用示例 #

Sub 批量转换主程序()
    Dim sourceFile As String
    sourceFile = FileSelected
    If sourceFile <> "" Then
        Call CSVConverted(sourceFile)
    End If
End Sub

内容的提问来源于stack exchange，提问作者Nicolas63