如何通过VBA从Excel导出（另存为）为CSV文件定义字段分隔符，编码和记录分隔符（{CR} {LF}） [英] How can Defining fields delimiter character, Encoding and Records seperator ({CR}{LF}) for CSV files in export (Save As) from Excel by VBA

问题描述

我以CSV格式将另存为的工作表与CSV格式绑定在一起，并在字段（逗号分隔），和{CR} {LF}的记录中按以下代码对齐。

I tied Save As my sheet in CSV format with (Comma Delimited) "," for fields and {CR}{LF} for records in line by below code.

1）生成的文件由;分隔

1) Generated file is delimited by ";" sign instead of ",".

2）确保记录用{CR} {LF}

2) Be sure records are separated by {CR}{LF}

3）如何将编码定义为Unicode UTF-8（在需要的情况下）

3) How can define encoding as Unicode UTF-8 (in situation if needed)

我希望此文件以.txt扩展名保存。

I want this file have save by .txt extension.

如何通过上述情况生成真实格式的CSV文件？

How can I generate CSV file in true format by above situation?

Sub GenCSV()

    Dim NewBook As Workbook

    Set NewBook = Workbooks.Add
    ThisWorkbook.Worksheets("Sheet1").Range("tblTaxRep[[Header1]: _
        [Headern]]").SpecialCells(xlCellTypeVisible).Copy
    With NewBook
        .Worksheets("Sheet1").Cells(1, 1).PasteSpecial (xlPasteValues)
        .SaveAs Filename:=ThisWorkbook.Path & "Report" & ".txt", FileFormat:=xlCSV
        .Close SaveChanges:=False

    End With

End Sub

推荐答案

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

< a href = https://www.mrexcel.com/forum/excel-questions/948333-visual-basic-applications-macro-save-excel-file-like-txt-utf-8-a.html#post4556223 rel = nofollow noreferrer>参考

这篇关于如何通过VBA从Excel导出（另存为）为CSV文件定义字段分隔符，编码和记录分隔符（{CR} {LF}）的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！