保存为UTF-8 CSV时日期格式异常的VB代码问题求助

核心问题根源 #

Excel的xlCSVUTF8格式是硬编码的：不管系统区域设置如何，强制用美式日期（m/d/yyyy）和逗号作为分隔符；而加Local:=True参数虽然会启用本地区域规则（分号、dd/mm/yyyy），但会导致CSV编码变成ANSI而非UTF-8，还容易破坏文件结构，完全不符合需求。

修正方案：手动生成UTF-8格式CSV #

绕开Excel自带的SaveAs限制，直接通过文本写入的方式，完全控制日期格式、分隔符和编码，彻底解决问题。

修改后的VBA代码 #

Sub exportCSV(path_name As String)
    Dim wb As Workbook, dataSheet As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim CRMid As String, dateColLetter As String
    Dim name_no_extension As String, newFileName As String
    Dim fileNum As Integer, i As Long, j As Long
    Dim cellValue As String, rowText As String
    
    Set wb = ThisWorkbook
    Set dataSheet = wb.Sheets("CRM template")
    
    ' 刷新透视表
    dataSheet.PivotTables("PivotTable2").ClearAllFilters
    dataSheet.PivotTables("PivotTable2").RefreshTable
    DoEvents
    
    ' 获取目标列的字母标识
    CRMid = getLetterOfColumn("Id", "CRM template")
    dateColLetter = getLetterOfColumn("Date (dd/mm/yyyy)", "CRM template") ' 这里要和你的日期列标题完全匹配
    lastCol = dataSheet.Cells(5, dataSheet.Columns.Count).End(xlToLeft).Column
    lastRow = dataSheet.Cells(dataSheet.Rows.Count, "B").End(xlUp).Row
    
    ' 把日期列强制转成dd/mm/yyyy格式的文本，避免Excel自动篡改
    dataSheet.Range(dateColLetter & "6:" & dateColLetter & lastRow).NumberFormat = "@"
    dataSheet.Range(dateColLetter & "6:" & dateColLetter & lastRow).Value = _
        Evaluate("TEXT(" & dateColLetter & "6:" & dateColLetter & lastRow & ",""dd/mm/yyyy"")")
    
    ' 生成保存路径和文件名
    name_no_extension = Replace(wb.Name, ".xlsm", "")
    newFileName = path_name & "\" & "TRACKER_" & name_no_extension & ".csv"
    
    ' 打开UTF-8格式文件（写入BOM头保证兼容性）
    fileNum = FreeFile()
    Open newFileName For Output As #fileNum
    Print #fileNum, Chr$(239) & Chr$(187) & Chr$(191) ' UTF-8 BOM标识
    
    ' 写入标题行
    rowText = ""
    For j = dataSheet.Columns(CRMid).Column To lastCol
        cellValue = Replace(dataSheet.Cells(5, j).Value, ";", ",") ' 替换内容里的分号，避免和分隔符冲突
        rowText = rowText & cellValue & ";"
    Next j
    rowText = Left(rowText, Len(rowText) - 1) ' 删掉最后多余的分号
    Print #fileNum, rowText
    
    ' 逐行写入数据
    For i = 6 To lastRow
        rowText = ""
        For j = dataSheet.Columns(CRMid).Column To lastCol
            cellValue = dataSheet.Cells(i, j).Value
            ' 处理内容里的换行和分号，防止破坏CSV结构
            cellValue = Replace(cellValue, vbCrLf, " ")
            cellValue = Replace(cellValue, ";", ",")
            rowText = rowText & cellValue & ";"
        Next j
        rowText = Left(rowText, Len(rowText) - 1)
        Print #fileNum, rowText
    Next i
    
    ' 关闭文件
    Close #fileNum
    
    MsgBox "CSV导出完成：" & newFileName, vbInformation
End Sub

关键修改说明 #

1. 锁死日期格式：用TEXT函数把日期转成dd/mm/yyyy的文本字符串，再设置单元格为文本格式，彻底避免Excel自动转成美式日期
2. 自定义分隔符：直接用分号;拼接每行内容，完全替代Excel默认的逗号
3. 保证UTF-8编码：写入文件前先加UTF-8的BOM头，确保文件编码符合要求
4. 兼容性处理：替换内容里的换行符和分号，防止这些字符破坏CSV的结构

辅助函数补充 #

如果你的代码里没有getLetterOfColumn函数，直接复制下面的实现即可：

Function getLetterOfColumn(headerText As String, sheetName As String) As String
    Dim ws As Worksheet
    Dim findRange As Range
    
    Set ws = ThisWorkbook.Sheets(sheetName)
    Set findRange = ws.Rows(5).Find(What:=headerText, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not findRange Is Nothing Then
        getLetterOfColumn = Split(findRange.Address, "$")(1)
    Else
        getLetterOfColumn = ""
        MsgBox "未找到指定列：" & headerText, vbExclamation
    End If
End Function

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