Attribute VB_Name = "ExportToTwiki1"
' Save this file to disk, In excel choose:
'   Tools -> Macros -> "Visual Basic Editor"
' Right click on "VBA Project (Personal.XLS)"
' Choose "Import File"
' Exit the window by clicking on the X decoration at the upper right,
'   or use Alt-Q, or choose File -> return to excel.
'
' Because you added this macro to your personal.XLS, it will
'   be available for all the spreadsheets you open.
'
' To export the current spreadsheet in TWiki format type Alt-F8 and
'    choose ExportDBToTWiki.
' To upload, open the export file in notepad or wordpad, copy and
'    paste into the TWiki edit window.

Sub ExportDBToTWiki()

' This macro saves the active worksheet to a pipe-delimited flat file
' with a user choosable file. It does not clear embedded
' pipe characters.

Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim DataTextStr As String
Dim FileName As String

Dim Filter As String
Filter = "All Files (*.*),*.*"
Dim Title As String
Title = "Select the Output File Name"

ListSep = "|"
Set SrcRg = ActiveSheet.UsedRange

FileName = Application.GetSaveAsFilename("c:\", Filter, , Title)
                    
' stop if user clicked cancel
If (FileName = "False") Then
  Exit Sub
End If

'Check for a trailing period and strip it.
If Right(FileName, 1) = "." Then
'Remove the period from the string.
   FileName = Left(FileName, Len(FileName) - 1)
End If

Open FileName For Output As #1

For Each CurrRow In SrcRg.Rows
  CurrTextStr = ListSep

  For Each CurrCell In CurrRow.Cells
    If (CurrCell.Value = "") Then
      ' two || next to each other spans columns. Add a space
      ' if the value is empty so that we preserve the column
      ' format
      CurrTextStr = CurrTextStr & " " & ListSep
    Else
      CurrTextStr = CurrTextStr & CurrCell.Value & ListSep
    End If
    Next
    
  While Right(CurrTextStr, 1) = ListSep
    CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
  Wend
  'Added next line to put | at end of each line
  CurrTextStr = CurrTextStr & ListSep
  Print #1, CurrTextStr

Next

Close #1
End Sub