Split large file into smaller files, keeping headers and footers

Question

I have a folder of SQL files which I need to loop through and:

1. Determine if any of the files are over 20MB
2. 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 & "*" & .Extension), .Extension, "") 'name only, no extension
    End With

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

        If File.Size >= 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 & "_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 & File.Name & "_" & i & File.Extension
                Open newFile For Output As #2

                'make iterative tweak to first row of header data
                File.Data(0) = Replace(File.Data(0), "_" & (i - 1), "_" & 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 < 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

Answer 1

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) > 0
        If (FileLen(FolderPath & FileNames) / FileSizeLimitBytes) > 1 Then SplitFiles (FolderPath & 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: " & Timer - TimeRoutine & " seconds. The file size is: " & FileSize & " 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) & "\" & _
                        FSO.GetBaseName(FilePath) & "_" & CStr(i) & _
                        "." & 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: " & Timer - TimeRoutine & " 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 = &H40000000
Private Const GENERIC_READ = &H80000000
Private Const FILE_ATTRIBUTE_NORMAL = &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 = &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) > 0
        If (FileLen(FolderPath & FileNames) / FileSizeLimitBytes) >= 1 Then SplitFiles (FolderPath & 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: " & Timer - TimeRoutine & " 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) & "\" & _
                            .GetBaseName(FilePath) & "_" & CStr(i) & _
                           "." & .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: " & Timer - TimeRoutine & " 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) <> 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 <> INVALID_HANDLE_VALUE Then

       Success = WriteFile(FileHandle, ByVal FileData, BytesToWrite, BytesWritten, 0) <> 0

       If Success <> 0 Then
          Success = FlushFileBuffers(FileHandle)
          Success = CloseHandle(FileHandle)
       End If

    End If

End Sub

Answer 2

You asked for performance and I think you got a great answer from @Ryan Wildry. This answer just addresses the other improvements for the code.

Type

I'll start with the top of the module -

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

I'd consider myself a little more than a beginner with VBA, but I had to look up excel's object model to figure this out. Looks to me like this would be better off as a Class.

And the Private declaration at the Module level is sort of hidden there so that when going through the SplitLargeFiles sub, the use of With File had me wondering if you were using a default Object implicitly that I was unaware of. That being said, why is that File declared at module level when it's only used by one procedure?

You really threw me for a loop there.

---

Variables

Dim newFile As String
Dim i As Long, j As Long, numberOfNewFiles As Long, rowsPerNewFile As Long

I like that you knew you had to give each variable a type when declaring them on a line. I also think your variable names are pretty good. But newFile as a string is sort of confusing, especially with your Type at the top. I'd also throw in a Const for some of those magic numbers and strings

Const PATH_TO As String = "\\server090\ACT Modelling\Investigations\Financial Metrics\Sprint_18\Financial Metrics\_JRL_2.46\InsertXmlTableData_20180221_1133\"
Const EXTENTION As String = ".sql"
Const HEADER_START As Long = 0
Const HEADER_END As Long = 11
Const MB_CONVERSION_DIVISOR As Long = 1000000
Const MAX_FILE_SIZE As Long = 20
Const DATA_TWEAK As String = "_0"
Const BUFFER_SIZE As Long = 22
Dim targetFile As TFile
Dim newFileName As String
Dim i As Long
Dim j As Long
Dim numberOfNewFiles As Long
Dim rowsPerNewFile As Long

Whoa now, looks like there will be a need to refactor some things down below. But I don't want to get ahead of myself.

---

Comments

You can see by some of my variable names that the only way I know what I might want to call it is with the comments. Like 'specific tweak to data.

Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.

---

Code Structure

Skeleton -

With File
End With
Do While Len(File.Name) > 0
    If File.Size >= MAX_FILE_SIZE Then
        With File
        End With
        For i = 1 To numberOfNewFiles
            For j = File.HeaderStart To File.HeaderEnd
            Next j
            For j = 1 To rowsPerNewFile
                If File.CurrentBodyPosition < File.FooterStart Then
                Else
                End If
            Next j
            For j = File.FooterStart To File.FooterEnd
            Next j
        Next i
    End If
Loop

No wonder your performance is taking a hit, you have three j loops in one i loop in a Do While Loop.

Why Excel

When you look at it that way you can see all those cycles you're going through for every File.Name. I'm not going to tell you what to do, but why are you splitting .sql files with excel VBA? I imagine they are essentially tables or even .csv but I can't imagine Excel VBA is the way to go. Maybe you're doing what you can with what you have, and there is nothing wrong with that, really. But I don't see any -

• Range
• Cell
• Sheet
• Book

All I really see is one Worksheet Function. On top of that, this is what you're working with -

_{Courtesy of Rubberduck-VBA}

Important note!

Please, don't take this as me disparaging you or your work! You made something that does what you needed it to do and you did it in a way that you knew. No matter what, that is admirable. That's why you're here at Code Review and not SO, because you want to get better at it.

I know it can be overwhelming to get your code picked apart. Sometimes you can't even take it all in at once, you end up making some tweaks and come back only to end up with some of the same feedback. That's the nature of the beast.

---

Refactoring

When you are repeating yourself over and over (like with those loops), you might benefit from refactoring the code. That in itself isn't necessarily a performance improvement, but it certainly makes the look better.

At your first If we can break it out

If File.Size >= MAX_FILE_SIZE Then DoThings File

Private Sub DoThings(ByVal targetFile As TFile)
    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 & DATA_TWEAK) '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 / BUFFER_SIZE, 0) '22 gives a buffer over 20
    rowsPerNewFile = (CLng(UBound(File.Data)) - CLng(18)) / numberOfNewFiles


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

        'make iterative tweak to first row of header data
        File.Data(0) = Replace(File.Data(0), "_" & (i - 1), "_" & 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 < 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 Sub

And we can split that out

Private Sub DoThings(ByVal targetFile As TFile)
    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 & DATA_TWEAK) 'specific tweak to data
        Close #1

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

Private Sub SplitFiles(ByVal targetFile As TFile)
    'determine how many files to split the data across, and hence how many rows each new file needs
    newFile = file.Path & file.Name & "_" & i & file.Extension
    Open newFile For Output As #2

    'make iterative tweak to first row of header data
    file.Data(0) = Replace(file.Data(0), "_" & (i - 1), "_" & 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 < 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
End Sub

and so on.

These are just examples, not taking into account what variables need to be passed on and not naming them perfectly. I've not addressed at all what it's doing, just the structure of doing it.

---

Answer 3

The majority of the time spent is loading the data into an Array. By replacing the Split function with my getTextFileLines function, I was able to reduce the time it took to load the Array from 64.41 seconds to 6.55 seconds. The overall time was reduced from 83.71 seconds to 18.5 seconds.

Function getTextFileLines(Path As String) As String()
    Const MAX_ROWS As Long = 30000000
    Dim text As String
    Dim fileNo As Integer, x As Long
    Dim data() As String
    ReDim data(MAX_ROWS)
    fileNo = FreeFile
    Open Path For Input As #fileNo
    Do While Not EOF(fileNo)
        Line Input #fileNo, text
        data(x) = text
        x = x + 1
    Loop
    Close #fileNo
    ReDim Preserve data(x - 1)
    getTextFileLines = data
End Function

Usage

'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 & "_0") 'specific tweak to data
Close #1

Replace the ↑Code Above↑ with the ↓Code Below↓

.Data = getTextFileLines(.FullPath)
.Data(0) = Replace(.Data(0), .Name, .Name & "_0") 'specific tweak to data

Addendum: A Better Way

It's been bothering me way it took longer to read a text files contents into a string then it took to read the file line by line into an array. The problem was I was using input(LOF(1), #FileBumber) which is not the most efficient way.

The correct approach is to create a buffer. You first buffer the string with Spaces equal to the number of characters in the file. Next you use the Get function to fill the buffer with the file data. This took 0.64 sec for 130MB file.

FileNumber = FreeFile()
Open File.FullPath For Binary Access Read As FileNumber
FileBuffer = Space$(LOF(FileNumber))
Get FileNumber, , FileBuffer
Close FileNumber

SQLFileSplitter: Class

I created the SQLFileSplitter class to simplify the process.

Option Explicit
'Sample Data: http://www.sample-videos.com/download-sample-sql.php
Const HEADER_LINE_COUNT As Long = 11
Const MAX_FILE_SIZE As Long = 20000000
Private Type TFile
    Cursor As Long
    Extension As String
    Footer As String
    FullPath As String
    Header1 As String
    Header2 As String
    LastCursor As Long
    MaxChunkSize As Long
    Name As String
    NewName As String
    PATH As String
End Type
Private File As TFile
Private FileBuffer As String

Public Sub SplitFile(ByVal FilePath As String, FileName As String, ByVal FileExt As String)
    If Not Right(FilePath, 1) = "\" Then FilePath = FilePath & "\"
    If Left(FileExt, 1) = "." Then FileExt = Right(FileExt, Len(FileExt) - 1)

    File.Extension = FileExt
    File.PATH = FilePath
    File.Name = Replace(FileName, "." & FileExt, "")
    File.FullPath = FilePath & File.Name & "." & FileExt

    setFileBuffer
    setFooter
    setHeader
    setMaxChunkSize

    setLastCursor
    CreatedFiles

End Sub

Private Sub CreatedFiles()
    Dim FileNumber As Long, Index As Long, NextCursor As Long
    Dim FullPath As String, Header As String
    Do
        Index = Index + 1
        File.NewName = File.Name & "_" & Index
        Header = Replace(File.Header1, File.Name, File.Name & "_" & Index) & File.Header2
        FullPath = File.PATH & File.NewName & "." & File.Extension
        NextCursor = InStrRev(Mid(FileBuffer, File.Cursor, File.MaxChunkSize), vbCrLf) + File.Cursor + File.MaxChunkSize

        If NextCursor > File.LastCursor Then NextCursor = File.LastCursor

        FileNumber = FreeFile()
        Open FullPath For Output As #FileNumber
        Print #FileNumber, Header
        Print #FileNumber, Mid(FileBuffer, File.Cursor, NextCursor - File.Cursor)
        Print #FileNumber, File.Footer
        Close #FileNumber
        File.Cursor = NextCursor
        DoEvents
    Loop Until File.Cursor >= File.LastCursor
End Sub

Private Sub setMaxChunkSize()
    File.MaxChunkSize = MAX_FILE_SIZE - Len(File.Header1) - Len(File.Header2) - 2
End Sub

Private Sub setLastCursor()
    File.LastCursor = Len(FileBuffer) - Len(File.Footer) - 1
End Sub

Private Sub setFileBuffer()
    Dim FileNumber As Long
    FileNumber = FreeFile()
    Open File.FullPath For Binary Access Read As FileNumber
    FileBuffer = Space$(LOF(FileNumber))
    Get FileNumber, , FileBuffer
    Close FileNumber
End Sub

Private Sub setFooter()
    Dim count As Long, pos As Long
    pos = Len(FileBuffer)
    Do While count < 5
        count = count + 1
        pos = InStrRev(FileBuffer, vbCrLf, pos - 1)
    Loop
    File.Footer = Mid$(FileBuffer, pos)
End Sub

Private Sub setHeader()
    Dim count As Long
    File.Cursor = InStr(FileBuffer, vbCrLf)
    File.Header1 = Left(FileBuffer, File.Cursor - 1)

    Do While count < HEADER_LINE_COUNT - 1
        count = count + 1
        File.Cursor = InStr(File.Cursor + 1, FileBuffer, vbCrLf)
    Loop
    File.Header2 = Mid$(FileBuffer, Len(File.Header1), File.Cursor)
End Sub

Main_SplitLargeFiles: Sub

Sub Main_SplitLargeFiles()
    Const PATH As String = "C:\"
    Const EXT As String = "sql"
    Dim FileName As String
    Dim t(1) As Double
    Dim SQLFileSplitter1 As SQLFileSplitter
    Set SQLFileSplitter1 = New SQLFileSplitter

    FileName = Dir(PATH & "*." & EXT)
    Do While FileName <> ""
        t(0) = Timer
        SQLFileSplitter1.SplitFile PATH, FileName, EXT
        t(1) = Round(Timer - t(0), 2)
        Debug.Print "This code ran successfully in " & t(1) & " seconds"
        FileName = Dir()
    Loop

End Sub

This code split a 130MB file in 6.33 seconds