Question

I have an Excel 2010 workbook. I need to save the used range of each of its worksheets as a tab-delimited text file with no quotes, with the same filename as the workbook and with an extension given by the worksheet name.

Note that Excel stupidly surrounds a value by quotes whenever it sees a comma, even though the delimiter is a tab; other than that, the normal “Save As” / “Text (Tab delimited)” would be fine.

I would prefer to do that using VBA code from within Excel.

If there is a Python solution, I’d be interested too. But at this point pywin32 support for Python 3 is only experimental, so I am not sure I can use it.

Answer 1

Ok here is a slightly complex routine which I wrote couple of months back for one of my clients. This code exports the Excel Worksheet to a Fixed Width File without QUOTES. Screenshots also attached. I am sure this code can be made even better 🙂

TRIED AND TESTED

Option Explicit

'~~> Change this to relevant output filename and path
Const strOutputFile As String = "C:\Output.Csv"

Sub Sample()
    Dim ws As Worksheet
    Dim rng As Range
    Dim MyArray() As Long, MaxLength As Long
    Dim ff As Long, i As Long, lastRow As Long, LastCol As Long
    Dim strOutput As String

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    '~~> Change this to the respective sheet
    Set ws = Sheets("Sheet1")
    LastCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    '~~> Loop through each Column to get the max size of the field
    For i = 1 To LastCol
        MaxLength = getMaxLength(ws, i)
        ReDim Preserve MyArray(i)
        MyArray(i) = MaxLength
    Next i

    ff = FreeFile

    '~~> output file
    Open strOutputFile For Output As #ff

    '~~> Write to text file
    With ws
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row

        For Each rng In .Range("A1:A" & lastRow)
            With rng
                For i = 1 To UBound(MyArray)
                    '~~> Insert a DELIMITER here if your text has spaces
                    strOutput = strOutput & " " & Left(.Offset(0, i-1).Text & _
                                String(MyArray(i), " "), MyArray(i))
                Next i

                Print #ff, Mid(Trim(strOutput), 1)
                strOutput = Empty
            End With
        Next rng
    End With

LetsContinue:
    On Error Resume Next
        Close #ff
    On Error GoTo 0
    Application.ScreenUpdating = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

'~~> Function to get the max size
Public Function getMaxLength(ws As Worksheet, Col As Long) As Long
    Dim lastRow As Long, j As Long

    getMaxLength = 0

    lastRow = ws.Range("A" & ws.Rows.Count).End(-4162).Row

    For j = 1 To lastRow
        If Len(Trim(ws.Cells(j, Col).Value)) > getMaxLength Then _
        getMaxLength = Len(Trim(ws.Cells(j, Col).Value))
    Next j
End Function