[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