You can add VBA code to your workbook to do the export.
The VBA routines below export a worksheet as a text file with a custom field delimiter. There are three routines:
ExportWorksheetWithCustomDelimiterQuery - This is a "wrapper" routine that can be called from VBA or as a macro. It queries the user for the export file path parameter and field delimiter parameter and then calls ExportWorksheetWithCustomDelimiter with those parameters using the currently active worksheet for the worksheet to be exported. This is the easiest way to export a worksheet without writing any additional VBA code.
ExportWorksheetWithCustomDelimiterDefault - This is a "wrapper" routine that can be called from VBA or as a macro. It calls ExportWorksheetWithCustomDelimiter with a default set of parameters. These default parameters can be changed as desired. Use this routine when the export file path and field delimiter are the same each time.
ExportWorksheetWithCustomDelimiter - This is the main routine that does the work. This routine can only be called from VBA code. The parameters to ExportWorksheetWithCustomDelimiter are explained in the routine.
Note that the resulting output contains the same values as formatted on the worksheet.
To implement this solution add the code below to any general code module.
[Begin Code Segment]
Public Sub ExportWorksheetWithCustomDelimiterQuery()
' Call the routine ExportWorksheetWithCustomDelimiter using a queried set of
' parameter values.
Dim FileName As String
Dim FilePath As String
Dim Delimiter As String
If InStrRev(ActiveWorkbook.Name, ".") = 0 Then
FileName = ActiveWorkbook.Name
Else
FileName = Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1)
End If
FilePath = Application.GetSaveAsFilename(FileName & ".txt", "Text File (*.txt), *.txt")
If FilePath = "False" Then Exit Sub
Do
Delimiter = Application.InputBox("Enter the field delimiter:", "Export Worksheet With Custom Delimiter", Type:=2)
If Delimiter = "False" Then Exit Sub
If Len(Delimiter) > 0 Then Exit Do
If MsgBox("Enter a field delimiter or click Cancel.", vbOKCancel, "Export Worksheet With Custom Delimiter") = vbCancel Then Exit Sub
Loop
ExportWorksheetWithCustomDelimiter ActiveSheet, FilePath, Delimiter
End Sub
Public Sub ExportWorksheetWithCustomDelimiterDefault()
' Call the routine ExportWorksheetWithCustomDelimiter using a predefined set of
' parameter values.
ExportWorksheetWithCustomDelimiter "Sheet1", "C:\Full\Path\To\OutputFile.txt", "|"
End Sub
Public Sub ExportWorksheetWithCustomDelimiter( _
ByVal SourceWorksheet As Variant, _
ByVal FilePath As String, _
ByVal Delimiter As String, _
Optional ByVal PrefaceText As String, _
Optional ByVal TrailingText As String _
)
' Exports the source worksheet as a text file with a custom field delimiter.
'
' Syntax
'
' ExportWorksheetWithCustomDelimiter(SourceWorksheet, FilePath, Delimiter)
'
' SourceWorksheet - The name of or a reference to a worksheet.
'
' FilePath - The full path to the export file.
'
' Delimiter - One or more characters to use as the field delimiter.
'
' PrefaceText - One or more characters to place in front of every record.
'
' TrailingText - One or more characters to place after every record.
Dim DisplayAlerts As Boolean
Dim FileNumber As Long
Dim FileData As String
If VarType(SourceWorksheet) = vbString Then SourceWorksheet = ActiveWorkbook.Sheets(SourceWorksheet).Name
' Create copy of source worksheet in new workbook
SourceWorksheet.Copy
' Save copy as tab delimited text file and close
DisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=FilePath, FileFormat:=xlText
ActiveWorkbook.Close SaveChanges:=False
Application.DisplayAlerts = DisplayAlerts
' Read file into string variable and delete file
FileNumber = FreeFile
Open FilePath For Binary Access Read Write As FileNumber
FileData = StrConv(InputB(LOF(FileNumber), FileNumber), vbUnicode)
Close FileNumber
Kill FilePath
' Replace all tabs with special character
FileData = Replace(FileData, Chr(9), Delimiter)
' Add preface text is specified
If Len(PrefaceText) > 0 Then
FileData = PrefaceText & Replace(FileData, vbCrLf, vbCrLf & PrefaceText)
FileData = Left(FileData, Len(FileData) - Len(PrefaceText))
End If
' Add trailing text if specified
If Len(TrailingText) > 0 Then
FileData = Replace(FileData, vbCrLf, TrailingText & vbCrLf)
End If
' Right modified text back out to same file
Open FilePath For Binary Access Read Write As FileNumber
Put FileNumber, , FileData
Close FileNumber
End Sub
[End Code Segment]
Kevin
