Export sheet as UTF-8 CSV file (using Excel-VBA)

后端 未结 3 1242
小鲜肉
小鲜肉 2020-12-16 07:17

I would like to export a file I have created in UTF-8 CSV using VBA. From searching message boards, I have found the following code that converts a file to UTF-8 (from this

3条回答
  •  清酒与你
    2020-12-16 07:39

    Here's my solution based on Excel VBA - export to UTF-8, which user3357963 linked to earlier. It includes macros for exporting a range and a selection.

    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
    

提交回复
热议问题