Text files deleting top 4 rows from multiple files at once

[cblake843]

I would like an idea how to delete the first four rows/lines/entries of all text files based in a directory. This could be up to 18 files at one time. Typically the header will be
start/end date , preamble , a source of the file.

I have experimented with code to do it one at a time but this is not an efficient method.



Function StripFirstfourLines(strInputFile As String, _
strOutputFile As String) As Boolean
On Error GoTo ProcError
'Dim inzo As String
'Dim outzo As String




Dim strRecord As String


' Open strInputFile for reading
Open strInputFile For Input As #1
'Open inzo For Input As #1


' Create the output filename by opening it.
Open strOutputFile For Output As #2
'Open outzo For Input As #2


Line Input #1, strRecord
Line Input #1, strRecord
Line Input #1, strRecord
Line Input #1, strRecord


Do While (Not EOF(1))
Line Input #1, strRecord
Print #2, strRecord
Loop


StripFirstfourLines = True


ExitProc:
On Error Resume Next
Close 'Close the files
DoEvents
Exit Function
ProcError:
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Error in procedure StripFirstfourLines..."
StripFirstfourLines = False
Resume ExitProc


End Function

[mancubus]

try



Sub vbax_53959_Delete_Top_N_Lines_From_All_Txt_Files_In_A_Folder()

Dim TxtFile As Object
Dim i As Long, DelLines As Long
Dim TxtFilesPath As String
Dim fso_ts

TxtFilesPath = "C:\TxtFiles\" 'change to suit
DelLines = 4

With CreateObject("Scripting.FileSystemObject")
For Each TxtFile In .GetFolder(TxtFilesPath).Files
With .OpenTextFile(TxtFilesPath & TxtFile.Name, ForReading, False)
fso_ts = Split(.ReadAll, vbNewLine, -1, vbTextCompare)
.Close
End With
With .OpenTextFile(TxtFilesPath & TxtFile.Name, ForWriting, True)
For i = DelLines To UBound(fso_ts) '0 based array. start writing from DelLines, not DelLines + 1
.WriteLine fso_ts(i)
Next
.Close
End With
Next TxtFile
End With

End Sub