将图纸导出为UTF-8 CSV文件（使用Excel VBA）

我想导出我使用VBA在UTF-8 CSV中创建的文件。通过搜索留言板，我找到了以下将文件转换为UTF-8（）的代码：

但是，此代码仅将非UTF-8文件转换为UTF-8。如果我将文件保存为非UTF-8格式，然后将其转换为UTF-8格式，那么文件中包含的所有特殊字符都将丢失，从而使该过程变得毫无意义

我想做的是用UTF-8（CSV）保存一个打开的文件。有没有办法用VBA实现这一点

---

n、 b.我也在网上问过这个问题。如果找到解决方案，将同时关闭两个线程。

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

---

这是我基于的解决方案，用户3357963在前面链接了它。它包括用于导出范围和选择的宏

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

---

最后，在Office2016中，您可以简单地在UTF8中将SAV保存为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保存到csv命名的测试中

我这里的示例将Excel中的一个范围导出为UTF-8 CSV。有一些更新，转换http、字符串或最后一个允许您指定范围。或者尝试一下，因为我遇到了完全相同的问题，我找到了您的消息，之后我在一个法国网站上找到了答案！它工作得很好！你能再详细说明一下吗。。。。顺便说一句，我找不到你答案的上下文：是的，我有Office 2016当我执行代码时，它总是说：“变量未定义”（xlCSVUTF8）。很抱歉，我已经更新并测试了它的工作原理。仍然是一样的！xlCSVUTF8看起来像一个变量，但您没有定义它。代码如何为您工作，而对我来说，它却在抱怨一个未定义的变量？您是否对其进行了全局定义？那么，它包含了什么？很奇怪，这是我在marco中放的唯一功能，没有其他功能。

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

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