Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Code for making a fixed width text file. 1

Status
Not open for further replies.

mpm32

Technical User
Feb 19, 2004
130
US
I am trying to create a fixed width text file from an excel worksheet. I have found some code to do this and I have modified it (I thought) to work for my purpose. I have 54 columns of data that I want to put into the file.

I have found the following code, when I run it it gives me a run time error type mismatch on the line; strCell = Left$(ws.Cells(i, j + 1).Value, s(j))

Can anyone help me figure this out?

Code:
Option Explicit
 
Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer)
    Dim i As Long, j As Long
    Dim strLine As String, strCell As String
     
     'get a freefile
    Dim fNum As Long
    fNum = FreeFile
     
     'open the textfile
    Open strFile For Output As fNum
     'loop from first to last row
     'use 2 rather than 1 to ignore header row
    For i = 2 To ws.Range("a65536").End(xlUp).Row
         'new line
        strLine = ""
         'loop through each field
        For j = 0 To UBound(s)
             'make sure we only take chars up to length of field (may want to output some sort of error if it is longer than field)
            strCell = Left$(ws.Cells(i, j + 1).Value, s(j))
             'add on string of spaces with length equal to the difference in length between field length and value length
            strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32))
        Next j
         'write the line to the file
        Print #fNum, strLine
    Next i
     'close the file
    Close #fNum
     
End Sub
 
 
 'for example the code could be called using:
 
Sub CreateFile()
    Dim sPath As String
    sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
    If LCase$(sPath) = "false" Then Exit Sub
     'specify the widths of our fields
     'the number of columns is the number specified in the line below +1
    Dim s(53) As Integer
     'starting at 0 specify the width of each column
    s(0) = 10
    s(1) = 9
    s(2) = 10
    s(3) = 25
    s(4) = 20
    s(5) = 20
    s(6) = 20
    s(7) = 20
    s(8) = 2
    s(9) = 10
    s(10) = 11
    s(11) = 11
    s(12) = 11
    s(13) = 11
    s(14) = 11
    s(15) = 11
    s(16) = 11
    s(17) = 11
    s(18) = 11
    s(19) = 11
    s(20) = 3
    s(21) = 1
    s(22) = 1
    s(23) = 2
    s(24) = 2
    s(25) = 1
    s(26) = 15
    s(27) = 15
    s(28) = 10
    s(29) = 10
    s(30) = 1
    s(31) = 1
    s(32) = 11
    s(33) = 11
    s(34) = 1
    s(35) = 3
    s(36) = 2
    s(37) = 11
    s(38) = 2
    s(39) = 2
    s(40) = 11
    s(41) = 11
    s(42) = 2
    s(43) = 11
    s(44) = 11
    s(45) = 2
    s(46) = 11
    s(47) = 11
    s(48) = 2
    s(49) = 11
    s(50) = 11
    s(51) = 2
    s(52) = 11
    s(53) = 11

    
     'for example to use 3 columns with field of length 5, 10 and 15 you would use:
     'dim s(2) as Integer
     's(0)=5
     's(1)=10
     's(2)=15
     'write to file the data from the activesheet
    CreateFixedWidthFile sPath, ActiveSheet, s
End Sub

Thanks in advance!
 
You may try this:
strCell = Left$(ws.Cells(i, j + 1).[!]Text[/!], s(j))

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886
 




The simplest way to generate a fixed width text file from a sheet is to SaveAs a .prn file.

Format ALL cell Fonts to any Courier (fixed pitch) font and adjust all column widths as required. Then SaveAs a .prn space delimited file. No code required.

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Is it possible that ActiveSheet isn't a Worksheet but something else, like maybe a Chart sheet?
 
That was it, thanks a bunch!

I went over each line many times and I would have never figured that out without your help.

Thanks again!
 
Ah, while I was replying, there were other posts, PHV's solution worked for me. I will also try the .prn solution too just to have that skill handy.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top