将工作表导出为UTF-8 CSV文件（使用Excel-VBA）

Question

我想使用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有什么办法吗？

我也曾在“ ozgrid”论坛上问过这个问题。如果找到解决方案，将同时关闭两个线程。

Answer 1

最后，在Office 2016中，您可以简单地将UTF8中的savs保存为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中。

Answer 2

更新此代码。我用这个来更改指定文件夹（标记为“Bron”）中的所有 .csv 文件，并将它们另存为另一个文件夹（标记为“doel”）中的 csv utf-8

\n\n

Sub SaveAsUTF8()\n\nDim fsT As Variant, tFileToOpen As String, tFileToSave As String\nDim Message As String\nDim wb As Workbook\nDim fileName As String\n\nSet wb = ActiveWorkbook\n\nWith Application\n.ScreenUpdating = False\n.DisplayAlerts = False\nEnd With\n\nMessage = "Source folder incorrect"\nSourceFolder = wb.Worksheets("Menu").Range("Bron") & "\\"\nIf Dir(SourceFolder, vbDirectory) = "" Or IsEmpty(SourceFolder) Then GoTo errorhandler\n\nMessage = "Target folder incorrect"\nTargetFolder = wb.Worksheets("Menu").Range("Doel") & "\\"\nIf Dir(TargetFolder, vbDirectory) = "" Or IsEmpty(TargetFolder) Then GoTo errorhandler\n\nfileName = Dir(SourceFolder & "\\*.csv", vbNormal)\n\nMessage = "No files available."\nIf Len(fileName) = 0 Then GoTo errorhandler\n\nDo Until fileName = ""\n\n    tFileToOpen = SourceFolder & fileName\n    tFileToSave = TargetFolder & fileName\n\n    tFileToOpenPath = tFileToOpen\n    tFileToSavePath = tFileToSave\n\nSet fsT = CreateObject("ADODB.Stream"): \'Create Stream object\nfsT.Type = 2: \'Specify stream type \xe2\x80\x93 we want To save text/string data.\nfsT.Charset = "utf-8": \'Specify charset For the source text data.\n\nfsT.Open: \'Open the stream\nfsT.LoadFromFile tFileToOpenPath: \'And write the file to the object stream\n\nfsT.SaveToFile tFileToSavePath, 2: \'Save the data to the named path\n\nfileName = Dir()\n\nLoop\n\nMessage = "Okay to remove all old files?"\nIf QuestionMessage(Message) = False Then\n    GoTo the_end\nElse\n    On Error Resume Next\n    Kill SourceFolder & "*.csv"\n    On Error GoTo errorhandler\nEnd If\n\nthe_end:\nWith Application\n.ScreenUpdating = True\n.DisplayAlerts = True\nEnd With\nExit Sub\n\nerrorhandler:\nWith Application\n.ScreenUpdating = True\n.DisplayAlerts = True\nEnd With\nCriticalMessage (Message)\nExit Sub\n\nEnd Sub\n\n\'----------\n\nFunction CriticalMessage(Message As String)\n\nMsgBox Message\n\nEnd Function\n\n\'----------\n\nFunction QuestionMessage(Message As String)\n\nIf MsgBox(Message, vbQuestion + vbYesNo) = vbNo Then\nQuestionMessage = False\nElse\nQuestionMessage = True\nEnd If\n\nEnd Function\n

\n