[ic] Macro to export from Excel
john.rennie at thechampagneshop.co.uk
Sun Sep 21 22:13:51 EDT 2003
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:
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
Application.GetSaveAsFilename(InitialFilename:=ActiveWorkbook.Path & "\", _
Title:="Output file name (will overwrite)")
If outputFile = False Then
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"
Print #1, tmpText;
If curField < numFields Then
Print #1, vbTab;
Print #1, vbLf;
MsgBox "File " & outputFile & " written. " & numFields & " fields, " &
numRows & " rows."
On Error Resume Next
MsgBox "Couldn't create/overwrite file."
The Champagne Shop Ltd
Tel 0870 0130105
Fax 01489 881163
More information about the interchange-users