[ic] Macro to export from Excel

John Rennie john.rennie at thechampagneshop.co.uk
Sun Sep 21 22:13:51 EDT 2003

Hi all,

First, apologies to all those who have progressed 'beyond' Microsoft

For those who haven't, here's a macro for exporting from Excel. I've seen a
fair amount of Excel-type questions here, and this should help with most of
them. I've been using it with Excel 2000 on Win XP to export the
products.txt file for my
site. Let me know (off-list is probably best) of any bugs you find, or where
should post things like this if the list is inappropriate.

I use it as a global macro (i.e., stored in personal.xls for Excel 2000).
products.txt reads correctly into Excel using the defaults; this does the
output for you. It will complain about line feeds in the data being written
but that's about all. It uses the standard tab-delimited, 'single line per
product' file format. It expects data in every field in the first line
the field names, so should be OK) and in the first column (the SKU, so again

Here's the code:
Sub WriteInterchangeFile()
Dim numFields As Integer
Dim numRows As Integer
Dim curField As Integer
Dim curRow As Integer
Dim tmpText As String
Dim outputFile As Variant

numFields = 0
numRows = 0
curField = 1
curRow = 1

' Count the fields
While ActiveSheet.Cells(1, numFields + 1) <> ""
  numFields = numFields + 1

' Count the rows
While ActiveSheet.Cells(numRows + 1, 1) <> ""
  numRows = numRows + 1

outputFile =
Application.GetSaveAsFilename(InitialFilename:=ActiveWorkbook.Path & "\", _
            Title:="Output file name (will overwrite)")
If outputFile = False Then
    Exit Sub
End If
On Error GoTo failed
Open outputFile For Output As #1

For curRow = 1 To numRows
  For curField = 1 To numFields
    tmpText = ActiveSheet.Cells(curRow, curField).Value
    If InStr(tmpText, vbLf) Then
      MsgBox "Line feed found in cell " & ActiveSheet.Cells(curRow,
curField).Address(False, False), vbExclamation, "Error"
    End If
    Print #1, tmpText;
    If curField < numFields Then
      Print #1, vbTab;
    End If
  Next curField
  Print #1, vbLf;
Next curRow
Close #1
MsgBox "File " & outputFile & " written. " & numFields & " fields, " &
numRows & " rows."

Exit Sub
On Error Resume Next
Close #1
MsgBox "Couldn't create/overwrite file."
End Sub

The Champagne Shop Ltd
Tel 0870  0130105
Fax 01489 881163 

More information about the interchange-users mailing list