Exporting To Fixed Field Width Files
This page describes how to export data to fixed field length files.
Elsewhere on this site we discussed exporting worksheet
data to a delmited file. This page describes how to export worksheet data to
a text file with fixed-length fields. For the opposite of this action, importing
fixed field length files to a worksheet, see Importing Fixed Width files.
The downloadable module file contains a function
named ExportFixedWidth that will allow your code to export
a range on a worksheet to a fixed field width text file. Each row of the worksheet
data is written to one line of the text file. The contents of that line are
governed by the FieldSpecs parameter, discussed below.
The declaration for the ExportFixedWidth function is as follows:
Function ExportFixedWidth(FileName As String, _
DataRange As Range, _
Append As Boolean, _
SkipEmptyRows As Boolean, _
PadRight As Boolean, _
ByVal PadChar As String, _
ByVal FieldSpecs As String) As Long
The FileName parameter names the text file to which
the data will be executed. The file need not exist. If it does not exist, it is
created. If it does exist, it is either destroyed and replaced or data is added
to the end of the file, leaving the original content in place. This is governed
by the Append parameter.
The DataRange is the range on the worksheet to export. Each
line in this range is exported to one line in the text file. DataRange
must have only one Area. Multiple Areas are no supported.
The Append parameter indicates what to do if FileName
already exists. if Append is True, the existing content of the file
is preserved and new data is written to the end of the file. If Append
is False, the existing file is destroyed and replaced with the new text output.
The SkipEmptyRows parameter governs what to do if an empty row
is found in the data range. If this parameter is False, an empty line is written to the
text file. If this parameter is True, no empty line is written out.
The PadRight parameter indicates how to pad the data field
if the value in the Excel worksheet is shorter than the specified width in the
FieldSpecs parameter, discussed below. If the value on
the worksheet is too short, it is padded on either the left or right to fill out
the field to the proper length. If PadRight is True,
the data is padded on the right, left-justifying the final field. If PadRight is
False, the data is padded on the left, right-justifying the final field.
The PadChar parameter specifies what character to use when
padding a data value. If PadChar is an empty string, a
space character is used. If PadRight is not empty,
the left-most character of the string is used.
The FieldSpecs parameter is a string that specifies how the
exported data is to be mapped to the text file line. It is of the format:
column,length|column,length|column,length
Each column element indicates what column on the worksheet
the data is to come from. This can be either the column number or the column letter.
The length element indicates how many characters to
take from the column field. For example,
1,10|15,6|C,10|D,15
specifies that four fields are to be extracted. The first is column 1 for a length
of 10. The second is column 15 for a length of 6, the third is column C for a length
of 10, and finally column D for a length of 15. If the length parameter is greater
than the length of the data in the worksheet, it is padded in accordance with
PadChar and PadRight. If the
length element is less than the length of the data on the worksheet, the data
is truncated on the right to fit the pattern. The field specification can be in any order and they may overlap.
For each line exported, the code calls a Privatefunction named
ExportThisRow. This function is passed the text that is ready to
be written to the text file. The function should return True if the line is to be written to the
text file, or False if the data is to be discarded and not written to the text file.
The function returns the number of rows exported, or -1 if an error occurred.
Function ExportFixedWidth(FileName As String, _
DataRange As Range, _
Append As Boolean, _
SkipEmptyRows As Boolean, _
PadRight As Boolean, _
ByVal PadChar As String, _
ByVal FieldSpecs As String) As Long
Dim R As Range
Dim FNum As Integer
Dim FInfos() As String
Dim FF() As String
Dim FInfo As String
Dim FLen As Long
Dim SpecLen As Long
Dim T As String
Dim RecCount As Long
Dim OutString As String
Dim N As Long
Dim FNdx As Long
Dim Col As Variant
Dim C As Long
Dim RW As Long
Dim FoundData As Boolean
If Len(FileName) = 0 Then
ExportFixedWidth = -1
Exit Function
End If
If DataRange Is Nothing Then
ExportFixedWidth = -1
Exit Function
End If
If Len(PadChar) = 0 Then
PadChar = Space(1)
Else
PadChar = Left(PadChar, 1)
End If
If Len(FieldSpecs) = 0 Then
ExportFixedWidth = -1
Exit Function
End If
If DataRange.Areas.Count > 1 Then
ExportFixedWidth = -1
Exit Function
End If
' get rid of any spaces in FieldSpecs
FieldSpecs = Replace(FieldSpecs, Space(1), vbNullString)
' get rid of double || characters
N = InStr(1, FieldSpecs, "||", vbBinaryCompare)
Do Until N = 0
FieldSpecs = Replace(FieldSpecs, "||", "|")
N = InStr(1, FieldSpecs, "||", vbBinaryCompare)
Loop
' get rid of double commas
N = InStr(1, FieldSpecs, ",,", vbBinaryCompare)
Do Until N = 0
FieldSpecs = Replace(FieldSpecs, ",,", ",")
N = InStr(1, FieldSpecs, ",,", vbBinaryCompare)
Loop
' remove leading and trailing pipes
If Left(FieldSpecs, 1) = "|" Then
FieldSpecs = Mid(FieldSpecs, 2)
End If
If Right(FieldSpecs, 1) = "|" Then
FieldSpecs = Left(FieldSpecs, Len(FieldSpecs) - 1)
End If
' remove any quotes and apostrophes
FieldSpecs = Replace(FieldSpecs, Chr(34), vbNullString)
FieldSpecs = Replace(FieldSpecs, "'", vbNullString)
FNum = FreeFile
If Append = True Then
Open FileName For Append Access Write As #FNum
Else
Open FileName For Output Access Write As #FNum
End If
Set R = DataRange(1, 1)
FInfos = Split(FieldSpecs, "|")
Do
DoEvents
If R.Row > DataRange(DataRange.Cells.Count).Row Then
Exit Do
End If
OutString = vbNullString
If ExportThisRow(R.EntireRow.Cells(1, "A")) = True Then
N = 0
FoundData = False
RW = R.Row
For C = DataRange(1, 1).Column To DataRange(DataRange.Cells.Count).Column
If Len(R.EntireRow.Cells(1, C).Formula) > 0 Then
FoundData = True
Exit For
End If
Next C
If SkipEmptyRows = False Or FoundData = True Then
For FNdx = LBound(FInfos) To UBound(FInfos)
DoEvents
FInfo = FInfos(FNdx)
FF = Split(FInfo, ",")
SpecLen = CLng(FF(1))
Col = FF(0)
If IsNumeric(Col) Then
Col = CLng(FF(0))
Else
Col = CStr(FF(0))
End If
T = R.EntireRow.Cells(1, Col).Text
FLen = Len(T)
If FLen < SpecLen Then
If PadRight Then
T = T & String(Abs(SpecLen - FLen), PadChar)
Else
T = String(Abs(SpecLen - FLen), PadChar) & T
End If
Else
T = Left(T, SpecLen)
End If
OutString = OutString & T
Next FNdx
Print #FNum, OutString
RecCount = RecCount + 1
End If
If R.Row > DataRange(DataRange.Cells.Count).Row Then
Exit Do
End If
End If
Set R = R(2, 1)
Loop
ErrH:
If Err.Number = 0 Then
ExportFixedWidth = RecCount
Else
ExportFixedWidth = -1
End If
Close #FNum
End Function
Private Function ExportThisRow(R As Range) As Boolean
ExportThisRow = True
End Function
|
This page last updated: 2-Sept-2011.
|