Question

我想使用VBA导出我用UTF-8 CSV创建的文件。从搜索留言板，我发现以下代码将文件转换为UTF-8（from this thread）：

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' forum上提出了这个问题。如果找到解决方案，将会将两个线程关闭在一起。

Answer 1

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

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

Answer 2

最后在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中。

Answer 3

以下是基于Excel VBA - export to 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

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

3 个答案: