MrExcel Publishing
Your One Stop for Excel Tips & Solutions

Exporting part of spreadsheet as a Text File

Posted by Geoff Smart on August 23, 2001 3:29 AM

I have an requirement to create standard length text files to load into a legacy system, I have developed the spreadsheet to use string manuipulation to create the formatted output, this is located in an output section of the spreadsheet. ( Fine so far! )

What I would like to do is to save this output section as a named text file.

I have tried print to file with a generic text printer, but that still seems to add gobble di gook to the file.

Copy & paste manually into Notepad is ok but is long winded.

Any ideas?

Posted by Jim North on August 27, 2001 10:50 AM

I found a workable answer

I asked the same question, but wasn't satisfied
by the response. After much digging I found (and
modified) the following:

Original Source from Microsoft Product Suppport Services Article ID: Q249885
Modified 08 Aug 2001

Prerequisites: (Before you run this macro, do the following)

- Select the cells to be included in the text file.
- Use the Style menu commands to format the worksheet to use a fixed-width font.
(For example, Courier is a fixed-width font)


- If the string is wider than the colomn width the left most positions, up to the column width, will be put into the output file. This may truncate your numbers. If you enlarge your column width the problem will be resolved.

Sub textfile()

Dim delimiter As String
Dim quotes As Integer
Dim Returned As String

delimiter = " "

' Specify if you want quotes to surround the cell information
' (0 = no 1 = yes)
quotes = 0

' Call the WriteFile function passing the delimiter and quotes options.
Returned = WriteFile(delimiter, quotes)

' Print a message box indicating if the process was completed.
Select Case Returned
Case "Canceled"
MsgBox "The export operation was canceled."
Case "Exported"
MsgBox "The information was exported."
End Select

End Sub


Function WriteFile(delimiter As String, quotes As Integer) As String

' Dimension variables to be used in this function.
Dim CurFile As String
Dim SaveFileName
Dim CellText As String
Dim RowNum As Integer
Dim ColNum As Integer
Dim FNum As Integer
Dim TotalRows As Double
Dim TotalCols As Double
Dim HalfWidth As Integer

' Show Save As dialog box with the .TXT file name as the default.
' Test to see what kind of system this macro is being run on.
If Left(Application.OperatingSystem, 3) = "Win" Then
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"Text Delimited (*.txt), *.txt", , "Text Delimited Exporter")
SaveFileName = Application.GetSaveAsFilename(CurFile, _
"TEXT", , "Text Delimited Exporter")
End If

' Check to see if Cancel was clicked.
If SaveFileName = False Then
WriteFile = "Canceled"
Exit Function
End If
' Obtain the next free file number.
FNum = FreeFile()

' Open the selected file name for data output.
Open SaveFileName For Output As #FNum

' Store the total number of rows and columns to variables.
TotalRows = Selection.Rows.Count
TotalCols = Selection.Columns.Count

' Loop through every cell, from left to right and top to bottom.
For RowNum = 1 To TotalRows
For ColNum = 1 To TotalCols
With Selection.Cells(RowNum, ColNum)
Dim ColWidth As Integer
ColWidth = Application.RoundUp(.ColumnWidth, 0)
' Store the current cells contents to a variable.
Select Case .HorizontalAlignment
Case xlRight
CellText = Space(ColWidth - Len(.Text)) & .Text
Case xlCenter
HalfWidth = (ColWidth - Len(.Text)) / 2
CellText = Space(HalfWidth) & .Text & _
Space(ColWidth - Len(.Text) - HalfWidth)
Case Else
If ColWidth >= Len(.Text) Then
CellText = .Text & Space(ColWidth - Len(.Text))
CellText = Left(.Text, ColWidth)
End If
End Select
End With
' Write the contents to the file.
' With or without quotation marks around the cell information.
Select Case quotes
Case vbYes
CellText = Chr(34) & CellText & Chr(34) & delimiter
Case vbNo
End Select
Print #FNum, CellText;

' Update the status bar with the progress.
Application.StatusBar = Format((((RowNum - 1) * TotalCols) _
+ ColNum) / (TotalRows * TotalCols), "0%") & " Completed."

' Loop to the next column.
Next ColNum
' Add a linefeed character at the end of each row.
If RowNum <> TotalRows Then Print #FNum, ""
' Loop to the next row.
Next RowNum

' Close the .prn file.
Close #FNum

' Reset the status bar.
Application.StatusBar = False
WriteFile = "Exported"

End Function