[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
tools...
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
I
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
out,
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
(usually
the field names, so should be OK) and in the first column (the SKU, so again
OK).
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
Wend
' Count the rows
While ActiveSheet.Cells(numRows + 1, 1) <> ""
numRows = numRows + 1
Wend
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
failed:
On Error Resume Next
Close #1
MsgBox "Couldn't create/overwrite file."
End Sub
The Champagne Shop Ltd
www.thechampagneshop.co.uk
Tel 0870 0130105
Fax 01489 881163
More information about the interchange-users
mailing list