Solved: Fixed length strings in text file output

[Ken Puls]

Hey guys,

I know that I can do this the hard way, but am wondering if there is an easier way to do it.

I need to create a text file of data for upload into my system. The deal is, though, that it needs to be in a text file, and it has to have its data in certain places as shown following (forgive the crude indenting):

Position Length Data required

1 - 6 - Date (MMDDYY)
7 - 10 - Member Number (left justified)
17 - 30 - Member Name (left justified)
47 - 1 - Not Used
48 - 10 - Check Number (right justified)
58 - 10 - Check Amount (leading zeros-implied decimal)
68 - 13 - Not Used

Some right aligned, some left aligned, etc.. Now I know I could build a string for an entire line, then dump it in one at a time, but this seems like overkill. Is there an easier way to build it in Excel and save it to the correct format with specified string lengths in the txt file output?

[JKwan]

See if this will do

Sub CreateCSV()
    ' This procedure will create custom CSV file structure
    Dim rCell, rRow As Range
    Dim vaColPad As Variant
    Dim i, lFNum As Long
    Dim sOutput As String
    Dim sFname As String
   
    ' Required width of columns
    ' This is set to have 5 columns
    ' A  B  C  D  E
    ' 0  0  6  0  4  padding of zeroes - none, none, 6, none, 4 - you get the idea
    vaColPad = Array(6, 3, 0, 0, 10)  ' modify your paddings here
    i = LBound(vaColPad)
   
    sFname = Application.GetSaveAsFilename( _
        InitialFileName:="CommaSeparatedValues.csv", _
        FileFilter:="Comma Separated Values, *.csv", _
        Title:="Save Comma Separated Values File")
    lFNum = FreeFile
   
    Open sFname For Output As lFNum
   
    'Loop through the rows
    For Each rRow In Sheet1.UsedRange.Rows
        'Loop through the cells in the rows
        For Each rCell In rRow.Cells
            'If the cell value is less than required, then pad
            'it with zeros, else just use the cell value
            If Len(rCell.Value) < vaColPad(i) Then
                sOutput = sOutput & Application.Rept(0, _
                    vaColPad(i) - Len(rCell.Value)) & rCell.Value & ","
            Else
                sOutput = sOutput & rCell.Value & ","
            End If
            i = i + 1
        Next rCell
        'remove the last comma
        sOutput = Left(sOutput, Len(sOutput) - 1)
       
        'write to the file and reinitialize the variables
        Print #lFNum, sOutput
        sOutput = ""
        i = LBound(vaColPad)
    Next rRow
   
    Close lFNum
   
End Sub

[Ken Puls]

Hmmm... yes. I think this gives me something to work with.

I hadn't thought of using Rept to pad the leading info, that's a good one. I was actually thinking of building a bunch of fixed length strings and appending them to the data set one by one:

[vba]Dim sDate As String * 6
Dim sMbrNum As String * 10
Dim sMbrNam As String * 30
Dim sNotUsd As String * 1
Dim sChkNum As String * 10
Dim sChkAmt As String * 10
Dim sNot2 As String * 13[/vba]

I'm sure I can blend something together out of this. Thanks, JKwan!

[JKwan]

You're welcome. I cannot take credit of the routine. I found it on the web. At times, this routine is very handy.

[Ken Puls]

Okay, here's an excerpt from my finished routine to show the route I went:

[vba] Dim sDate As String * 6
Dim sMbrNum As String * 6
Dim sMbrNam As String * 30
Dim sNot1 As String * 5
Dim sChkNum As String * 10
Dim sChkAmt As String * 10
Dim sNot2 As String * 13
Dim sFname As String
Dim lFnum As Long

'Assign the file to the TempWB variable
Set TempWB = ActiveWorkbook

'Prepare a file for payments output

sFname = "L:\ImportFiles\FNBLKBX.TXT"
lFnum = FreeFile
Open sFname For Output As lFnum

'Format all data as required by Jonas import specification
With TempWB.Sheets(1)
With .Range("A1:H" & .Cells(.Rows.Count,1).End(xlUp).Row)
.AutoFilter Field:=1, Criteria1:="<>TRNS*", Operator:=xlAnd
.SpecialCells(xlVisible).EntireRow.Delete
End With
.Columns("B").Insert
lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

For lRow = lLastRow To 1 Step -1
With .Range("A" & lRow)
Select Case Application.WorksheetFunction.Trim(.Offset(0, 7).Value)

'Build the payment string for output to the payments file
Case Is = "Payment"
bPymnts = True
sDate = Format(.Offset(0, 4), "MMDDYY")
sMbrNum = ConvertMembNo(GetMemberNo(.Offset(0, 5)))
sMbrNam = Left(.Offset(0, 5), 30)
sChkNum = Application.Rept(Chr(32), 7 - Len(.Offset(0, 2))) & _
"Trn" & .Offset(0, 2)
sChkAmt = Application.Rept(0, 10 - Len(.Offset(0, 6).Value * 100) - 1) & _
Abs(.Offset(0, 6).Value * 100)
Print #lFnum, sDate & sMbrNum & sMbrNam & sNot1 & sChkNum & sChkAmt & sNot2
.EntireRow.Delete

'Build the charges file
Case Is = "Charge"
.Value = ConvertMembNo(GetMemberNo(.Offset(0, 5)))
.Offset(0, 1).Value = Format(.Offset(0, 4), "yyyy/mm/dd")
If .Offset(0, 3).Value = "INVOICE" Then
.Offset(0, 3).Value = "PSIN"
.Offset(0, 4).Value = "Pro Shop Charges"
Else
.Offset(0, 3).Value = "PSCN"
.Offset(0, 4).Value = "Pro Shop Credit"
End If
.Offset(0, 5).Value = .Offset(0, 6).Value
.Offset(0, 6).Value = 0
.Offset(0, 7).Value = 0
.Offset(0, 8).Value = 0
.Offset(0, 9).Value = 0
End Select
End With
Next lRow
.Columns("F:J").NumberFormat = "General"
End With

'Close the payments file
Close lFnum[/vba]

Now those are only the pertinent parts of the routine. It actually creates two files. The text file is illustrated above, but any remaining lines in the source file are saved into a csv file for a different import. (My vendor uses some fixed width text, some csv, deletes some on upload, not others, very inconsistent.)

Regardless, I just though I'd share how I was able to pull it together. The basic gist of it is to create a bunch of fixed length strings, then combine them and print them to the text file. This allows the data to retain specific character start points in the data file for my upload. Using the Rept function that JKwan suggested allowed me to right align the data in some of those strings as well.

Cheers!