我想导出使用 VBA 以 UTF-8 CSV 创建的文件。通过搜索留言板，我发现了以下将文件转换为 UTF-8 的代码（来自此线程）：
Sub SaveAsUTF8()
Dim fsT, tFileToOpen, tFileToSave As String
tFileToOpen = InputBox("Enter the name and location of the file to convert" & vbCrLf & "With full path and filename ie. C:\MyFolder\ConvertMe.Txt")
tFileToSave = InputBox("Enter the name and location of the file to save" & vbCrLf & "With full path and filename ie. C:\MyFolder\SavedAsUTF8.Txt")
tFileToOpenPath = tFileToOpen
tFileToSavePath = tFileToSave
Set fsT = CreateObject("ADODB.Stream"): 'Create Stream object
fsT.Type = 2: 'Specify stream type – we want To save text/string data.
fsT.Charset = "utf-8": 'Specify charset For the source text data.
fsT.Open: 'Open the stream
fsT.LoadFromFile tFileToOpenPath: 'And write the file to the object stream
fsT.SaveToFile tFileToSavePath, 2: 'Save the data to the named path
End Sub
但是，此代码仅将非 UTF-8 文件转换为 UTF-8。如果我以非 UTF-8 格式保存文件，然后将其转换为 UTF-8，它就会丢失其中包含的所有特殊字符，从而使该过程毫无意义！
我想要做的是将打开的文件保存为 UTF-8 (CSV)。有没有办法用VBA做到这一点？
n.b.我还在'ozgrid'论坛上问过这个问题。如果我找到解决方案，将关闭两个线程。
最后在 Office 2016 中，您可以简单地以 UTF8 格式保存为 CSV。
Sub SaveWorkSheetAsCSV()
Dim wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
Dim name As String
Set wsSource = ThisWorkbook.Worksheets(1)
name = "test"
Application.DisplayAlerts = False 'will overwrite existing files without asking
Set wsTemp = ThisWorkbook.Worksheets(1)
Set wbNew = ActiveWorkbook
Set wsTemp = wbNew.Worksheets(1)
wbNew.SaveAs name & ".csv", xlCSVUTF8 'new way
wbNew.Close
Application.DisplayAlerts = True
End Sub
这会将工作表 1 保存到名为 test 的 csv 中。
更新此代码。我用这个来更改指定文件夹（标记为“Bron”）中的所有 .csv 文件，并将它们另存为另一个文件夹（标记为“doel”）中的 csv utf-8
Sub SaveAsUTF8()
Dim fsT As Variant, tFileToOpen As String, tFileToSave As String
Dim Message As String
Dim wb As Workbook
Dim fileName As String
Set wb = ActiveWorkbook
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Message = "Source folder incorrect"
SourceFolder = wb.Worksheets("Menu").Range("Bron") & "\"
If Dir(SourceFolder, vbDirectory) = "" Or IsEmpty(SourceFolder) Then GoTo errorhandler
Message = "Target folder incorrect"
TargetFolder = wb.Worksheets("Menu").Range("Doel") & "\"
If Dir(TargetFolder, vbDirectory) = "" Or IsEmpty(TargetFolder) Then GoTo errorhandler
fileName = Dir(SourceFolder & "\*.csv", vbNormal)
Message = "No files available."
If Len(fileName) = 0 Then GoTo errorhandler
Do Until fileName = ""
tFileToOpen = SourceFolder & fileName
tFileToSave = TargetFolder & fileName
tFileToOpenPath = tFileToOpen
tFileToSavePath = tFileToSave
Set fsT = CreateObject("ADODB.Stream"): 'Create Stream object
fsT.Type = 2: 'Specify stream type – we want To save text/string data.
fsT.Charset = "utf-8": 'Specify charset For the source text data.
fsT.Open: 'Open the stream
fsT.LoadFromFile tFileToOpenPath: 'And write the file to the object stream
fsT.SaveToFile tFileToSavePath, 2: 'Save the data to the named path
fileName = Dir()
Loop
Message = "Okay to remove all old files?"
If QuestionMessage(Message) = False Then
GoTo the_end
Else
On Error Resume Next
Kill SourceFolder & "*.csv"
On Error GoTo errorhandler
End If
the_end:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
Exit Sub
errorhandler:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
CriticalMessage (Message)
Exit Sub
End Sub
'----------
Function CriticalMessage(Message As String)
MsgBox Message
End Function
'----------
Function QuestionMessage(Message As String)
If MsgBox(Message, vbQuestion + vbYesNo) = vbNo Then
QuestionMessage = False
Else
QuestionMessage = True
End If
End Function
这是我基于 Excel VBA - 导出到 UTF-8 的解决方案，user3357963 之前链接到了该解决方案。它包括用于导出范围和选择的宏。
Option Explicit
Const strDelimiter = """"
Const strDelimiterEscaped = strDelimiter & strDelimiter
Const strSeparator = ","
Const strRowEnd = vbCrLf
Const strCharset = "utf-8"
Function CsvFormatString(strRaw As String) As String
Dim boolNeedsDelimiting As Boolean
boolNeedsDelimiting = InStr(1, strRaw, strDelimiter) > 0 _
Or InStr(1, strRaw, Chr(10)) > 0 _
Or InStr(1, strRaw, strSeparator) > 0
CsvFormatString = strRaw
If boolNeedsDelimiting Then
CsvFormatString = strDelimiter & _
Replace(strRaw, strDelimiter, strDelimiterEscaped) & _
strDelimiter
End If
End Function
Function CsvFormatRow(rngRow As Range) As String
Dim arrCsvRow() As String
ReDim arrCsvRow(rngRow.Cells.Count - 1)
Dim rngCell As Range
Dim lngIndex As Long
lngIndex = 0
For Each rngCell In rngRow.Cells
arrCsvRow(lngIndex) = CsvFormatString(rngCell.Text)
lngIndex = lngIndex + 1
Next rngCell
CsvFormatRow = Join(arrCsvRow, ",") & strRowEnd
End Function
Sub CsvExportRange( _
rngRange As Range, _
Optional strFileName As Variant _
)
Dim rngRow As Range
Dim objStream As Object
If IsMissing(strFileName) Or IsEmpty(strFileName) Then
strFileName = Application.GetSaveAsFilename( _
InitialFileName:=ActiveWorkbook.Path & "\" & rngRange.Worksheet.Name & ".csv", _
FileFilter:="CSV (*.csv), *.csv", _
Title:="Export CSV")
End If
Set objStream = CreateObject("ADODB.Stream")
objStream.Type = 2
objStream.Charset = strCharset
objStream.Open
For Each rngRow In rngRange.Rows
objStream.WriteText CsvFormatRow(rngRow)
Next rngRow
objStream.SaveToFile strFileName, 2
objStream.Close
End Sub
Sub CsvExportSelection()
CsvExportRange ActiveWindow.Selection
End Sub
Sub CsvExportSheet(varSheetIndex As Variant)
Dim wksSheet As Worksheet
Set wksSheet = Sheets(varSheetIndex)
CsvExportRange wksSheet.UsedRange
End Sub
有人找到解决方案了吗？我看到最初的发布日期是 2014 年，但 10 年后我也遇到了同样的问题。
我在 MS Excel (.xlsx) 中制作了一个表单，然后编写了以下 VBA 代码并将文件另存为 .xlsm 在我的 Microsfot OneDrive 上。 OneDrive 是我办公室的 Windows PC 和 MacBook 上的同步工具，我在其中启动 VBA 代码（在网络版本上它不运行）。
VBA代码没问题。创建了 .csv 代码但是，我不明白！当我手动将文件保存为 .csv（文件，另存为，.csv UTF-8）时，它运行得很好。例如，名称“Müller Jürg”在 .csv 中保留原样。 相反，如果我让 VBA 创建文件 .csv，则名称结果为“Mller Jrg”，没有元音变音/特殊字符。
有人可以帮助我吗？
这是我的 VBA 代码（创建 .csv 的部分以粗体显示）：
Sub ExportToCSV()
Dim savePath As String
Dim csvFileName As String
Dim currentFilePath As String
Dim ws As Worksheet
Dim lastRow As Long
Dim dataComplete As Boolean
Dim rowCounter As Long
Dim col As Integer
' current file path on OneDrive
currentFilePath = ThisWorkbook.Path
**' Set .CSV file name
csvFileName = Format(Now(), "yyyy - mm-dd - HH-mm-ss") & " - users list.csv"**
' Set active worksheet
Set ws = ThisWorkbook.ActiveSheet
' Determine last row with data in column A
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' Initialize flag dataComplete to True
dataComplete = True
' Cicle on rows from 5 to last with data
For rowCounter = 5 To lastRow
' Check all columns from A to L for current row
For col = 1 To 12 ' From 1 to 12 represent columns from A to L
If IsEmpty(ws.Cells(rowCounter, col)) Or Trim(ws.Cells(rowCounter, col).Value) = "" Then
' If a cell is empty, set dataComplete to False and exit from cicle
dataComplete = False
Exit For ' Exit from the cycle For col
End If
Next col
' If a row is not complete, exit from cycle
If Not dataComplete Then Exit For
Next rowCounter
' If the data are not complete, show a message and stop the procedure
If Not dataComplete Then
MsgBox "Verify data completeness to proceed", vbExclamation
Exit Sub
End If
' If the data are complete, proceed with the export to CSV
' Delete the “Sheet2” sheet if it exists
On Error Resume Next
Application.DisplayAlerts = False ' Disable warning messages
ThisWorkbook.Sheets("Sheet2").Delete
Application.DisplayAlerts = True ' Ensable warning messages
On Error GoTo 0
' Create a temporary copy of the active sheet
ThisWorkbook.ActiveSheet.Copy
Set ws = ActiveSheet
' Delete the first three lines
ws.Rows("1:3").Delete
**' Save the temporary sheet as a .csv file
ws.SaveAs FileName:=currentFilePath & "\" & csvFileName, FileFormat:=xlCSV, Local:=True**
' Close the temporary sheet without saving the changes
Application.DisplayAlerts = False ' Disable warning messages
ws.Parent.Close SaveChanges:=False
Application.DisplayAlerts = True ' Enable warning messages
MsgBox ".csv file exported successfully!"
结束子