Excel VBA另存为没有分隔符的文本文件

时间:2017-11-17 07:26:45

标签: excel vba excel-vba delimiter separator

我正在尝试使用宏将输出表从excel转换为文本文件,但是可以转换没有分隔符的文件吗?我现有的代码只能保存为制表符分隔,但我上传文本文件的系统会将制表符空格检测为多余字符。

这是我现有的VBA代码:

Sub SaveAsTXT()
Dim parts As Variant

parts = Split(ActiveWorkbook.Name, ".")
parts(UBound(parts)) = ".txt"

ActiveWorkbook.SaveAs Filename:=ActiveWorkbook.Path & "\" & _
    Join(parts, "."), FileFormat:=xlTextWindows, CreateBackup:=False
End Sub

1 个答案:

答案 0 :(得分:2)

您需要分隔符或分隔符以显示不同的区分字段。

在下面的方法中,有一个代码,您可以根据需要选择值分隔符。

现在,字符作为默认分隔符。

关于以下代码的说明:

  • rngRange参数:是您要在* .txt文件中导出为报告的源范围。
  • strSeparator:是您在此处定义的合适分隔符。

...

sub Report
    CsvExportRange rngRange:=ThisWorkbook.Worksheets("Sheet1").Range("tblTaxRep"), _
        strFileName:="C:\" & ".txt", _
        strCharset:="UTF-8", strSeparator:=",", strRowEnd:=vbCrLf, NVC:=False
End Sub
Sub CsvExportRange(rngRange As Object, strFileName As String, strCharset, strSeparator As String, strRowEnd As String, NVC As Boolean) 'NVC: _
    Null Value Control (If cell contain Null value, suppose reached end of range), d: delimiter

    Dim rngRow As Range
    Dim objStream As Object
    Dim i, lngFR, lngLR As Long 'lngFR: First Row, lngLR: Last Row

    lngFR = rngRange.SpecialCells(xlCellTypeVisible).Rows(1).row - rngRange.Rows(1).row + 1
    lngLR = rngRange.End(xlDown).row - rngRange.Rows(1).row + 1

    Set objStream = CreateObject("ADODB.Stream")
    objStream.Type = 2
    objStream.Charset = strCharset
    objStream.Open

    For i = lngFR To lngLR
        If Not (rngRange.Rows(i).EntireRow.Hidden) Then
            If IIf(NVC, (Cells(i + rngRange.Rows(1).row - 1, _
                rngRange.SpecialCells(xlCellTypeVisible).Columns(1).column).Value = vbNullString), False) Then Exit For
            objStream.WriteText CsvFormatRow(rngRange.Rows(i), strSeparator, strRowEnd)
        End If
    Next i

    objStream.SaveToFile strFileName, 2
    objStream.Close
End Sub 'CsvExportRange

Function CsvFormatRow(rngRow As Variant, strSeparator As String, strRowEnd As String) As String

    Dim arrCsvRow() As String

    ReDim arrCsvRow(rngRow.SpecialCells(xlCellTypeVisible).Cells.Count - 1)
    Dim rngCell As Range
    Dim lngIndex As Long

    lngIndex = 0

    For Each rngCell In rngRow.SpecialCells(xlCellTypeVisible).Cells
        arrCsvRow(lngIndex) = CsvFormatString(rngCell.Value, strSeparator)
        lngIndex = lngIndex + 1
    Next rngCell

    CsvFormatRow = Join(arrCsvRow, strSeparator) & strRowEnd

End Function 'CsvFormatRow

Function CsvFormatString(strRaw, strSeparator As String) As String

    Dim boolNeedsDelimiting As Boolean

    Dim strDelimiter, strDelimiterEscaped As String

    strDelimiter = """"
    strDelimiterEscaped = strDelimiter & strDelimiter

    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 'CsvFormatString