How to export all sheets in a workbook to a single text file?

Question

It seems that the Workbook.SaveAs method does not support appending to file (otherwise I could slightly modify one of the common solutions).

I know I can use the Open statement and write line by line, but I prefer a more high-level solution.

Answer 1

Based on this answer, here is a line-by-line solution with vbTab as delimiter:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim wsSheet As Worksheet
    Dim nFileNum As Integer
    Dim txtPath As String
    Dim FirstSheet As Boolean

    Application.ScreenUpdating = False

    txtPath = ActiveWorkbook.FullName
    txtPath = Replace(txtPath, "xlsm", "txt")
    nFileNum = FreeFile

    FirstSheet = True
    For Each wsSheet In Worksheets
        If FirstSheet = True Then
            ' Overwrite
            Open txtPath For Output As #nFileNum
        Else
            ' Append
            Open txtPath For Append As #nFileNum
        End If

        wsSheet.Activate
        ExportToTextFile CStr(nFileNum), vbTab, False, Not (FirstSheet)

        Close #nFileNum

        FirstSheet = False

    Next wsSheet

    Application.ScreenUpdating = True

End Sub


Public Sub ExportToTextFile(nFileNum As Integer, _
                            Sep As String, SelectionOnly As Boolean, _
                            SkipHeader As Boolean)

    Dim WholeLine As String
    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim StartCol As Integer
    Dim EndCol As Integer
    Dim CellValue As String

    On Error GoTo EndMacro:

    If SelectionOnly = True Then
        With Selection
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    Else
        With ActiveSheet.UsedRange
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    End If

    If SkipHeader = True Then
        StartRow = StartRow + 1
    End If

    For RowNdx = StartRow To EndRow
        WholeLine = ""
        For ColNdx = StartCol To EndCol
            If Cells(RowNdx, ColNdx).Value = "" Then
                CellValue = ""
            Else
                CellValue = Cells(RowNdx, ColNdx).Value
            End If
            WholeLine = WholeLine & CellValue & Sep
        Next ColNdx
        WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
        Print #nFileNum, WholeLine
    Next RowNdx

EndMacro:
    On Error GoTo 0

End Sub