Excel VBA另存为不带分隔符的文本文件

文斯·奥萨纳

我正在尝试使用宏将输出表从 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

用户8949440

您需要分隔符或分隔符来区分不同的字段。

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

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

关于以下代码的注意事项：

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

本文收集自互联网，转载请注明来源。

如有侵权，请联系 [email protected] 删除。