VBA Help!!! Urgent!! Macro not pikcing the footer row..can some help Please...

[sesgiri]

Hi All

Macro should copy Header and Footer with the values.

sample File:
HDR 09232013
DTLC000000062C01 Ganesh 80 Wistlestreet Ahmedabad XX12345 0101201001012010123120780004 NMAENY0101C
TLR 000000002







VB:


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 = 1 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


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(6) As Integer
'starting at 0 specify the width of each column
s(0) = 3
s(1) = 15
s(2) = 60
s(3) = 60
s(4) = 60
s(5) = 30
s(6) = 2
s(7) = 9
s(8) = 15
s(9) = 8
s(10) = 8
s(11) = 8
s(12) = 15
s(13) = 15
s(14) = 1
s(15) = 2
s(15) = 1
s(16) = 10
s(17) = 391
'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

 

[CharlesChuckieCharles]

I think this is better


Does any part of the footer occupy Column A ( since thats the column where you're getting your row depth from) ??

Option Explicit
Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer)
Dim i As Long, j As Long
Dim strLine As String

Dim lCurrentDepth As Long
'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
    lCurrentDepth = ws.Cells(Rows.Count, 1).End(xlUp).Row
    
    'Move down row by row
    For i = 1 To lCurrentDepth
    'new line
    strLine = ""
    'move left to right across each column
        For j = 0 To UBound(s)
            'make sure we only take chars up to length of field  pad with spaces if shorter
            strLine = strLine & Left$(Trim(ws.Cells(i, j + 1).Value) & Space(s(j)), s(j))
        'next column
        Next j
        
    'write the line to the file
    
    Print #fNum, strLine
    
    'next row
    
    Next i
'close the file
Close #fNum

End Sub

Sub CreateFile()
Dim sPath As Variant
sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
If 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() As Integer
'starting at 0 specify the width of each column
ReDim s(17)
s(0) = 3
s(1) = 15
s(2) = 60
s(3) = 60
s(4) = 60
s(5) = 30
s(6) = 2
s(7) = 9
s(8) = 15
s(9) = 8
s(10) = 8
s(11) = 8
s(12) = 15
s(13) = 15
s(14) = 1
s(15) = 2
s(15) = 1
s(16) = 10
s(17) = 391
'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

 

[sesgiri]

Thank you for your reply. Footer starts at C Column at the bottom like the Header.

I am getting below error while trying your code

'compile error

ByRef Argument type mismatch

 

[CharlesChuckieCharles]

Changed the Depth count to column C to he foot row is added to the depth

My BAD Variant passed as String


Its better to check that the empty file choice Boolen using a variant

see below

Option Explicit
Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer)
Dim i As Long, j As Long
Dim strLine As String

Dim lCurrentDepth As Long
'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
    lCurrentDepth = ws.Cells(Rows.Count, "C").End(xlUp).Row
    
    'Move down row by row
    For i = 1 To lCurrentDepth
    'new line
    strLine = ""
    'move left to right across each column
        For j = 0 To UBound(s)
            'make sure we only take chars up to length of field  pad with spaces if shorter
            strLine = strLine & Left$(Trim(ws.Cells(i, j + 1).Value) & Space(s(j)), s(j))
        'next column
        Next j
        
    'write the line to the file
    
    Print #fNum, strLine
    
    'next row
    
    Next i
'close the file
Close #fNum

End Sub

Sub CreateFile()
Dim sPath As String
Dim VPath As Variant
sPath = Application.GetSaveAsFilename("", "Text Files,*.txt")
If VPath = False Then Exit Sub
'specify the widths of our fields
'the number of columns is the number specified in the line below +1
sPath = VPath
Dim s() As Integer
'starting at 0 specify the width of each column
ReDim s(17)
s(0) = 3
s(1) = 15
s(2) = 60
s(3) = 60
s(4) = 60
s(5) = 30
s(6) = 2
s(7) = 9
s(8) = 15
s(9) = 8
s(10) = 8
s(11) = 8
s(12) = 15
s(13) = 15
s(14) = 1
s(15) = 2
s(15) = 1
s(16) = 10
s(17) = 391
'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