Split large file into smaller files, keeping headers and footers I have a folder of SQL files which I need to loop through and: 


Determine if any of the files are over 20MB
If so, split them into multiple files, max 20MB filesize


However, there's a complication in that the original large file will have a header and a footer which needs to be included (and slightly tweaked) in each one of the broken down files. 

Here is a graphical representation, if it helps. It's based on one file in particular, which is 130MB, with around 1.8m rows



Of course I’m very happy to receive any and all feedback about my code. However, my main issue is that my current code takes around 20 minutes to break this main file into seven smaller counterparts. Therefore, any speed improvements would be fantastic!

Option Explicit

Private Type TFile
    Path As String
    Name As String
    Extension As String
    FullPath As String
    Size As String
    Data() As String
    CurrentBodyPosition As Long
    HeaderStart As Long
    HeaderEnd As Long
    FooterStart As Long
    FooterEnd As Long
End Type
Private File As TFile

Public Sub SplitLargeFiles()
    Dim newFile As String
    Dim i As Long, j As Long, numberOfNewFiles As Long, rowsPerNewFile As Long

    With File
        .HeaderStart = 0 'header always in the same position
        .HeaderEnd = 11
        .CurrentBodyPosition = .HeaderEnd + 1
        .Path = "\\...\"
        .Extension = ".sql"
        .Name = Replace(Dir(.Path &amp; "*" &amp; .Extension), .Extension, "") 'name only, no extension
    End With

    Do While Len(File.Name) &gt; 0
        File.FullPath = File.Path &amp; File.Name &amp; File.Extension
        File.Size = FileLen(File.FullPath) / 1000000 'filesize in MB
        Debug.Print File.Size

        If File.Size &gt;= 20 Then

            With File
                'open file, transfer data to an array and close it
                Open .FullPath For Input As #1
                .Data = Split(input(LOF(1), #1), vbNewLine)
                .Data(0) = Replace(.Data(0), .Name, .Name &amp; "_0") 'specific tweak to data
                Close #1

                'now assign footer positions
                .FooterStart = UBound(.Data) - 5
                .FooterEnd = UBound(.Data)
            End With

            'determine how many files to split the data across, and hence how many rows each new file needs
            numberOfNewFiles = WorksheetFunction.RoundUp(File.Size / 22, 0) '22 gives a buffer over 20
            rowsPerNewFile = (CLng(UBound(File.Data)) - CLng(18)) / numberOfNewFiles


            For i = 1 To numberOfNewFiles
                newFile = File.Path &amp; File.Name &amp; "_" &amp; i &amp; File.Extension
                Open newFile For Output As #2

                'make iterative tweak to first row of header data
                File.Data(0) = Replace(File.Data(0), "_" &amp; (i - 1), "_" &amp; i)

                'transfer header data
                For j = File.HeaderStart To File.HeaderEnd
                    Print #2, File.Data(j)
                Next j

                'transfer body of data
                For j = 1 To rowsPerNewFile
                    If File.CurrentBodyPosition &lt; File.FooterStart Then
                        Print #2, File.Data(File.CurrentBodyPosition)
                        File.CurrentBodyPosition = File.CurrentBodyPosition + 1
                    Else
                        Exit For
                    End If
                Next j

                'transfer footer data
                For j = File.FooterStart To File.FooterEnd
                    Print #2, File.Data(j)
                Next j

                Close #2
            Next i
        End If
        File.Name = Replace(Dir(), File.Extension, "")
    Loop
End Sub
When writing lots of data, it's better to write all of it in one shot wherever possible. 

My code only addresses your specific performance issue, e.g. takes too long to run! It lacks the header and footer manipulation needed, however this should be easy to add in at this point. I'd recommend manipulating this in an Array or StringBuilder before ready to write. Overall, your code is clear, just the method employed is non-optimized for this much data. 

I separated the directory loop from the split action. It seemed to me finding a qualifying file and splitting the file were separate actions, so it made sense (to me anyway) to split these activities up into separate Subs.

I used utilized the FileSystemObject to make it easier to build a new file path for new files that were split. Also, you had some Magic Numbers I made those into constants, as it is, it's non-obvious what 1000000 is meant to represent.

Feel free to ask questions if something isn't clear, I tried to comment the code as much as possible. 



Edit 

Made a few tweaks changes with how I'm reading the file in. Seems to be about 10% faster.



Edit 2

For completeness I included (stole?) Thomas Inzina great idea for reading the file line by line. This sped things up considerably. See the revised timings below.

Code

Option Explicit

Public Sub FindFilesToSplit()

    Dim FolderPath As String
    Dim FileNames  As String
    Const FileSizeLimitBytes As Long = 20000000
    FolderPath = "E:\Ex\"

    FileNames = Dir(FolderPath)

    Do While Len(FileNames) &gt; 0
        If (FileLen(FolderPath &amp; FileNames) / FileSizeLimitBytes) &gt; 1 Then SplitFiles (FolderPath &amp; FileNames)
        FileNames = Dir
    Loop

End Sub

Private Sub SplitFiles(ByRef FilePath As String)
    Const BytesToMBs As Long = 1000000
    Const FileSizeThresholdMBs As Long = 20

    Dim TimeRoutine     As Single: TimeRoutine = Timer
    Dim FSO             As FileSystemObject
    Dim FileNumber      As Long
    Dim FileSize        As Long
    Dim FileData()      As String
    Dim NumberOfFiles   As Long
    Dim LinesToRead     As Long
    Dim i               As Long
    Dim j               As Long
    Dim k               As Long
    Dim SplitFileName   As String
    Dim StartingLine    As Long
    Dim EndingLine      As Long
    Dim ChunkofFile     As Variant

    Set FSO = New FileSystemObject
    FileSize = FileLen(FilePath) \ BytesToMBs

    'Compute how many files are going to be needed
    NumberOfFiles = (FileSize \ FileSizeThresholdMBs) + 1

    'Using Thomas Inzina approach here instead, it's a lot faster
    'Awesome stuff Thomas Inzina :)
    FileData = GetTextFileLines(FilePath)

    Debug.Print "Reading and splitting the file took: " &amp; Timer - TimeRoutine &amp; " seconds. The file size is: " &amp; FileSize &amp; " MBs"
    TimeRoutine = Timer

    'Compute the number of lines to read for each iteration
    LinesToRead = (UBound(FileData) \ NumberOfFiles) + 1

    'Use to variables to keep track which lines to read
    'Assumption: each line equally is equal terms of space requirements
    'To be safe you may want to increment LinesToRead by 2 just in case :)
    StartingLine = LBound(FileData)
    EndingLine = LinesToRead

    For i = 1 To NumberOfFiles
        'Resize an array to hold data for a single file
        ReDim ChunkofFile(0 To (EndingLine - StartingLine))

        k = 0
        'Add the text back to a smaller array
        For j = StartingLine To EndingLine
            ChunkofFile(k) = FileData(j)
            k = k + 1
        Next

        'Build the string name for the new file
        'The file name mirrors the parent file, just with an
        'iteration number suffix
        SplitFileName = FSO.GetParentFolderName(FilePath) &amp; "\" &amp; _
                        FSO.GetBaseName(FilePath) &amp; "_" &amp; CStr(i) &amp; _
                        "." &amp; FSO.GetExtensionName(FilePath)

        StartingLine = StartingLine + LinesToRead + 1

        'Adjust ending line to read as dividing by the number of files -
        'won't divide evenly (most of the time)
        If i = NumberOfFiles - 1 Then
            EndingLine = UBound(FileData)
        Else
            EndingLine = EndingLine + LinesToRead + 1
        End If

        'Write the file by joining the array just created
        FileNumber = FreeFile()
        Open SplitFileName For Output Access Write As FileNumber
        Print #FileNumber, Join(ChunkofFile, vbNewLine)
        Close #FileNumber
    Next

    Debug.Print "Rest of Process took: " &amp; Timer - TimeRoutine &amp; " seconds"
End Sub

Private Function GetTextFileLines(ByRef Path As String) As String()
    Const MAX_ROWS  As Long = 30000000
    Dim TextLine    As String
    Dim FileNumber  As Integer
    Dim i           As Long
    Dim TextArray() As String

    ReDim TextArray(MAX_ROWS)

    FileNumber = FreeFile
    Open Path For Input Access Read As #FileNumber

    Do While Not EOF(FileNumber)
        Line Input #FileNumber, TextLine
        TextArray(i) = TextLine
        i = i + 1
    Loop
    Close #FileNumber

    ReDim Preserve TextArray(i - 1)
    GetTextFileLines = TextArray
End Function


Results

The performance is pretty good. I'm processing a ~200MB file into 11 files in about 12 seconds.

Debug Messages:

Reading and splitting the file took: 4.609375 seconds. The file size is: 219 MBs
Rest of Process took: 7.953125 seconds




Edit 3

Let's go for even faster performance! It's been fun trying to make this even faster. 

Splitting really slows things down, so I'm ditching it entirely. Instead I'm writing every N number of characters instead. So you do lose the tidy look of split per line with this approach, but the files are still split up equally. It should be possible to keep the lines together by looking ahead/behind to find the linebreak character, I just didn't bother.

I'm using several Win APIs to get a speed boost in a few places. To keep this simple, I did not add the VBA7/win64 API signatures, but this should be easy to do. 

Improvements

The Space$() buffer allocation can be somewhat slow when allocating that much buffer, so I replaced with a new approach.

Also, I'm using the CreateFile API too. VBA is a kinda slow writing files, this helped a bit with speed too. All in all, I've got splitting and writing a 130MB file in less than 2 seconds (~1.89 seconds).

Revised Code

Option Explicit

Private Const GENERIC_WRITE = &amp;H40000000
Private Const GENERIC_READ = &amp;H80000000
Private Const FILE_ATTRIBUTE_NORMAL = &amp;H80
Private Const OPEN_ALWAYS = 4
Private Const INVALID_HANDLE_VALUE = -1
Private Const CREATE_ALWAYS = 2
Private Const BytesToMBs As Long = 1000000
Private Const FileSizeThresholdMBs As Long = 20
Private Const FileSizeLimitBytes As Long = 20000000
Private Const FILE_FLAG_WRITE_THROUGH = &amp;H80000000

Private Declare Sub RtlMoveMemory Lib "kernel32" (dst As Any, src As Any, ByVal nBytes As Long)
Private Declare Function SysAllocStringByteLen Lib "oleaut32" (ByVal olestr As Long, ByVal BLen As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, _
    ByVal nNumberOfBytesToWrite As Long, _
    lpNumberOfBytesWritten As Long, ByVal lpOverlapped As Long) As Long

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, _
    ByVal dwDesiredAccess As Long, _
    ByVal dwShareMode As Long, _
    ByVal lpSecurityAttributes As Long, _
    ByVal dwCreationDisposition As Long, _
    ByVal dwFlagsAndAttributes As Long, _
    ByVal hTemplateFile As Long) As Long

Private Declare Function FlushFileBuffers Lib "kernel32" (ByVal hFile As Long) As Long

Private Function AllocString(ByVal Size As Long) As String
    RtlMoveMemory ByVal VarPtr(AllocString), SysAllocStringByteLen(0, Size + Size), 4
End Function

Public Sub FindFilesToSplit()
On Error GoTo ErrorHandler:

    Dim FolderPath As String
    Dim FileNames  As String

    FolderPath = "E:\Ex\"
    FileNames = Dir$(FolderPath)

    Do While Len(FileNames) &gt; 0
        If (FileLen(FolderPath &amp; FileNames) / FileSizeLimitBytes) &gt;= 1 Then SplitFiles (FolderPath &amp; FileNames)
        FileNames = Dir$
    Loop

CleanExit:
    Exit Sub

ErrorHandler:
    Resume CleanExit
End Sub

Private Sub SplitFiles(ByRef FilePath As String)
    Dim TimeRoutine     As Single: TimeRoutine = Timer
    Static FSO          As FileSystemObject
    Dim FileNumber      As Long
    Dim FileData        As String
    Dim NumberOfFiles   As Long
    Dim CharsToRead     As Long
    Dim i               As Long
    Dim SplitFileName   As String
    Dim StartingChar    As Long
    Dim EndingChar      As Long

    If FSO Is Nothing Then Set FSO = New FileSystemObject

    'Compute how many files are going to be needed
    NumberOfFiles = ((FileLen(FilePath) \ BytesToMBs) \ FileSizeThresholdMBs) + 1

    'Get File data
    TimeRoutine = Timer
    FileNumber = FreeFile()
    Open FilePath For Binary Access Read As FileNumber
    FileData = AllocString(LOF(FileNumber))
    Get FileNumber, , FileData
    Close FileNumber

    Debug.Print "Reading and splitting the file took: " &amp; Timer - TimeRoutine &amp; " seconds. The file is 130 mb"
    TimeRoutine = Timer

    'Compute the number of lines to read for each iteration
    CharsToRead = (Len(FileData) \ NumberOfFiles)

    'Counters to keep track of which character we read
    StartingChar = 1
    EndingChar = CharsToRead

    For i = 1 To NumberOfFiles
        'Create the file name
        With FSO
            SplitFileName = .GetParentFolderName(FilePath) &amp; "\" &amp; _
                            .GetBaseName(FilePath) &amp; "_" &amp; CStr(i) &amp; _
                           "." &amp; .GetExtensionName(FilePath)
        End With

        'Write the file
        WriteStringToFile SplitFileName, Mid$(FileData, StartingChar, CharsToRead)
        StartingChar = StartingChar + CharsToRead + 1

        'Adjust ending line to read as dividing by the number of files -
        'won't divide evenly (most of the time)
        EndingChar = IIf(i = NumberOfFiles - 1, Len(FileData), EndingChar + CharsToRead + 1)
    Next

    Debug.Print "Rest of Process took: " &amp; Timer - TimeRoutine &amp; " seconds"
End Sub

Private Sub WriteStringToFile(ByRef FileName As String, _
                              ByRef FileData As String, _
                              Optional NoOverwrite As Boolean = False)

    Dim FileHandle         As Long
    Dim Success            As Long
    Dim BytesWritten       As Long
    Dim BytesToWrite       As Long

    'Quick Fail
    If NoOverwrite = True And Dir$(FileName) &lt;&gt; vbNullString Then Exit Sub

    BytesToWrite = Len(FileData)

    FileHandle = CreateFile(FileName, GENERIC_WRITE Or GENERIC_READ, _
                            0, 0, CREATE_ALWAYS, FILE_FLAG_WRITE_THROUGH, 0)

    If FileHandle &lt;&gt; INVALID_HANDLE_VALUE Then

       Success = WriteFile(FileHandle, ByVal FileData, BytesToWrite, BytesWritten, 0) &lt;&gt; 0

       If Success &lt;&gt; 0 Then
          Success = FlushFileBuffers(FileHandle)
          Success = CloseHandle(FileHandle)
       End If

    End If

End Sub