These pages are no longer updated and are only available for archive purposes.

Click here to visit the pages with updated information.

Export to delimited text files

This macro exports the values or formulas from a worksheet range to a delimited text file:

Sub ExportRangeAsDelimitedText(SourceWB As String, _
    SourceWS As String, SourceAddress As String, _
    TargetFile As String, SepChar As String, SaveValues As Boolean, _
    ExportLocalFormulas As Boolean, AppendToFile As Boolean)
' Exports the data in Workbooks(SourceWB).Worksheets(SourceWS).Range(SourceAddress) to
' the textfile TargetFile in CSV format, uses SepChar as column delimiter
' Example:     ExportRangeAsDelimitedText ThisWorkbook.Name, _
    "ExportSheet", "A3:E23", "C:\FolderName\DelimitedText.txt", _
    ";", True, True, False


Dim SourceRange As Range, SC As String * 1
Dim A As Integer, r As Long, c As Integer, totr As Long, pror As Long
Dim fn As Integer, LineString As String, tLine As String
    ' validate the input data if necessary
    Workbooks(SourceWB).Activate
    Worksheets(SourceWS).Activate
    If Application.WorksheetFunction.CountA(Range(SourceAddress)) = 0 Then Exit Sub
    If Not AppendToFile Then
        If Dir(TargetFile) <> "" Then
            On Error Resume Next
            Kill TargetFile
            On Error GoTo 0
            If Dir(TargetFile) <> "" Then
                MsgBox TargetFile & _
                    " already exists, rename, move or delete the file before you try again.", _
                    vbInformation, "Export range to textfile"
                Exit Sub
            End If
        End If
    End If
    If UCase(SepChar) = "TAB" Or UCase(SepChar) = "T" Then
        SC = Chr(9)
    Else
        SC = Left(SepChar, 1)
    End If
    
    ' perform export
    Set SourceRange = Range(SourceAddress)
    On Error GoTo NotAbleToExport
    fn = FreeFile
    Open TargetFile For Append As #fn ' open textfile for new input
    On Error GoTo 0
    ' determine the total number of rows to process
    totr = 0
    For A = 1 To SourceRange.Areas.Count
        totr = totr + SourceRange.Areas(A).Rows.Count
    Next A
    ' start writing the character-separated textfile
    pror = 0
    For A = 1 To SourceRange.Areas.Count
        For r = 1 To SourceRange.Areas(A).Rows.Count
            LineString = ""
            For c = 1 To SourceRange.Areas(A).Columns.Count
                tLine = ""
                On Error Resume Next
                If SaveValues Then
                    tLine = SourceRange.Areas(A).Cells(r, c).Value
                Else
                    If ExportLocalFormulas Then
                        tLine = SourceRange.Areas(A).Cells(r, c).FormulaLocal
                    Else
                        tLine = SourceRange.Areas(A).Cells(r, c).Formula
                    End If
                End If
                On Error GoTo 0
                LineString = LineString & tLine & SC
            Next c
            pror = pror + 1
            If pror Mod 50 = 0 Then
                Application.StatusBar = "Writing delimited textfile " & _
                    Format(pror / totr, "0 %") & "..."
            End If
            If Len(LineString) > 1 Then LineString = Left(LineString, Len(LineString) - 1)
            If LineString = "" Then
                Print #fn,
            Else
                Print #fn, LineString
            End If
        Next r
    Next A
    Close #fn ' close the textfile
NotAbleToExport:
    Set SourceRange = Nothing
    Application.StatusBar = False
End Sub

Document last updated 1999-10-13 12:50:53