Truncate a big text file in multiple pieces using vba

[Jimmy509]

Hello,
I am working with big text file that I want to cut down in smaller pieces. The file has a 3 line header and 3 line footer. I want to be able to read the header and footer lines. Then read a chunk of the text file, write it to a new file (_part1) and add the header lines and the footer lines to that file. Then move on to the next set of line of text and do the same. I want to have the option to write to each new file a set of number of lines of KB (say 5000 lines or 50 KB). Then save each file as _partX.txt.
So far this is what I have but I am stuck, please help.

Sub Text_file_parser()
Dim FSO As FileSystemObject
Dim txtStream As TextStream
Dim DetFile As String
Dim sFile As String
Dim New_file As Object
Dim file_path, New_filename, New_filepath As String
Dim i, j, k As Integer
Dim header, body, footer As Variant
Dim File_size As Long


DetFile = "C:\Users\avalcourt\Documents\9.7B RDTE\test"
sFile = Dir(DetFile & "\*.txt")
file_path = DetFile & "\" & sFile
'MsgBox file_path
New_filename = "New_" & sFile
New_filepath = DetFile & "\" & New_filename
'MsgBox New_filepath
'MsgBox file_path
Set FSO = New FileSystemObject
Set txtStream = FSO.OpenTextFile(file_path, ForReading, False)


'Set the number of File
File_size = FileLen(file_path) ' remove in function
Debug.Print File_size

If Not FSO.FileExists(New_filepath) Then

Set New_file = FSO.CreateTextFile(New_filepath, False, True) 'Error here
'Do Until txtStream.AtEndOfStream
i = 0
j = 0
k = 0

For i = 1 To 3
   ThisLine = txtStream.ReadLine
   'i = i + 1
   'Debug.Print "Line " & i, ThisLine
  New_file.WriteLine (ThisLine)

Next
Else
'Set txtStream = FSO.OpenTextFile(New_filepath, ForWriting, False)
Set New_file = FSO.OpenTextFile(New_filepath, ForWriting, False)
For i = 1 To 3
   ThisLine = txtStream.ReadLine
   'i = i + 1
   'Debug.Print "Line " & i, ThisLine
  
   New_file.WriteLine (ThisLine)

Next

  ' Loop
End If
Do While Not txtStream.AtEndOfStream
   txtStream.SkipLine
   FooterLine = txtStream.ReadLine
   Debug.Print FooterLine
Loop



txtStream.Close
End Sub

 

[Jimmy509]

Updating the post
I am working with big text file that I want to cut down in smaller pieces. The file has a 3 line header and 3 line footer. I want to be able to read the header and footer lines. Then read a chunk of the text file, write it to a new file (_part1) and add the header lines and the footer lines to that file. Then move on to the next set of line of text and do the same. I want to have the option to write to each new file a set of number of lines of KB (say 5000 lines or 50 KB). Then save each file as _partX.txt.
So far this is what I have. I can read in the header lines and the one footer line. I want to read all 3 footer line (Last 3 lines of the file). I am still not sure how take the first 5000 lines and write the header lines, the 5000 lines then the footer lines and save that file. then do the same for the next 5000 lines until the end of file.

    Sub Text_file_parser()
    Dim FSO As FileSystemObject
    Dim txtStream As TextStream
    Dim DetFile As String
    Dim sFile As String
    Dim New_file As Object
    Dim file_path, New_filename, New_filepath As String
    Dim i, j, k As Integer
    Dim header, body, footer As Variant
    Dim File_size As Long
   
   
    DetFile = "C:\Documents"
    sFile = Dir(DetFile & "\*.txt")
    file_path = DetFile & "\" & sFile
    'MsgBox file_path
    New_filename = "New_" & sFile
    New_filepath = DetFile & "\" & New_filename
    'MsgBox New_filepath
    'MsgBox file_path
    Set FSO = New FileSystemObject
    Set txtStream = FSO.OpenTextFile(file_path, ForReading, False)
   
   
    'Set the number of File
    File_size = FileLen(file_path)
    Debug.Print File_size
   
    If Not FSO.FileExists(New_filepath) Then
   
    Set New_file = FSO.CreateTextFile(New_filepath, False, True)
    'Do Until txtStream.AtEndOfStream
    i = 0
    j = 0
    k = 0
   
    For i = 1 To 3
       ThisLine = txtStream.ReadLine
       'i = i + 1
       'Debug.Print "Line " & i, ThisLine
      New_file.WriteLine (ThisLine)
   
    Next
    Else
    'Set txtStream = FSO.OpenTextFile(New_filepath, ForWriting, False)
    Set New_file = FSO.OpenTextFile(New_filepath, ForWriting, False)
    For i = 1 To 3
       ThisLine = txtStream.ReadLine
       'i = i + 1
       'Debug.Print "Line " & i, ThisLine
     
       New_file.WriteLine (ThisLine)
   
    Next
   
      ' Loop
    End If
    Do While Not txtStream.AtEndOfStream
       txtStream.SkipLine
       FooterLine = txtStream.ReadLine
       Debug.Print FooterLine
    Loop
   
   
   
    txtStream.Close
    End Sub