How can Defining fields delimiter character, Encoding and Records seperator ({CR}{LF}) for CSV files in export (Save As) from Excel by VBA

大城市里の小女人 提交于 2019-12-13 02:58:23

问题


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

The issue is:

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

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

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

I want this file have save by .txt extension.

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

回答1:


Saddly, the answer may not be what you expect. The issues that you are experiencing are all related to the .SaveAs method, which has standard file structures. Excel seems unable to save the files in your specified format, particularly as CSV's in UTF-8. The following posts may help you find a solution:

Excel to CSV with UTF8 encoding

Is it possible to force Excel recognize UTF-8 CSV files automatically?




回答2:


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

Reference



来源:https://stackoverflow.com/questions/45189564/how-can-defining-fields-delimiter-character-encoding-and-records-seperator-cr

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!