Сплит большой файл на несколько файлов меньшего размера, сохранив заголовки и нижние колонтитулы


У меня есть папка SQL-файлов, которые мне нужно перебрать и:

  1. Определить, если любой из файлов более 20МБ
  2. Если это так, то разделить их на несколько файлов, максимальный размер файла 20МБ

Однако, есть осложнение в том, что оригинальный файл будет иметь заголовок и нижний колонтитул, который должен быть включен (и немного переделаны) в каждом из разбитых файлов.

Вот графическое представление, если это помогает. Он основан на одном файле, в частности, что 130 МБ, около 1,8 м рядами

screenshot

Я, конечно, очень рады получить любую обратную связь о моем коде. Однако, моя главная проблема в том, что мой текущий код занимает около 20 минут, чтобы разорвать этот основной файл на семь более мелких собратьев. Поэтому любое увеличение скорости будет фантастическим!

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


365
6
задан 21 февраля 2018 в 06:02 Источник Поделиться
Комментарии
3 ответа

При записи большого количества данных, лучше писать все это в одном кадре, где это возможно.

Мой код только решает ваши конкретные проблемы с производительностью, например, занимает слишком много времени! Ему не хватает заголовка и необходимых манипуляций в футере, однако это должно быть легко добавить в в этой точке. Я бы рекомендовал использовать данное в Array или StringBuilder прежде чем приступать к написанию. В целом, ваш код-это понятно, просто используемый метод не оптимизирован для этого много данных.

Я отделила петли каталог из Сплита действий. Мне показалось, находя квалификационной файла и разделение файла были отдельные действия, так что это имело смысл (для меня во всяком случае), чтобы разделить эти действия на отдельные Сабы.

Я использовал FileSystemObject чтобы сделать его легче построить новый файл путь для новых файлов, которые были разделены. Кроме того, у вас некоторые магии чисел я сделал их в постоянных, как это не очевидно, что 1000000 предназначен для представления.

Не стесняйтесь задавать вопросы, если что-то не понятно, я постарался прокомментировать код, насколько это возможно.


Редактировать

Сделал несколько Щипков изменения с тем, как я читаю файл. Кажется, около 10% быстрее.


Правка 2

Для полноты картины я включил (украл?) Томас Inzina отличная идея для чтение файла построчно. Это значительно ускорил события. См. пересмотренный тайминги ниже.

Код

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

Результаты

Производительность довольно хорошая. Я обработки файла ~200МБ на 11 файлов примерно за 12 секунд.

Отладочных Сообщений:

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


Редактировать 3

Давайте пойдем еще быстрее! Это было весело, пытаясь сделать это еще быстрее.

Расщепление очень замедляет весь процесс, поэтому я оставляю его целиком. Вместо этого я пишу каждый Н количество символов вместо. Так что вы не теряют опрятный вид Сплита в соответствии с этим подходом, но файлы по-прежнему разделились поровну. Это должно быть возможным, чтобы сохранить линии, глядя вперед/позади, чтобы найти символ новой строки, я просто не заморачиваются.

Я использую несколько выигрывать API, чтобы получить прирост скорости в несколько мест. Чтобы сделать это просто, не добавить VBA7/х64 API для подписей, но это должно быть легко сделать.

Улучшения

В Space$() буфер выделения могут быть немного медленной при выделении , что значительно буфера, поэтому я заменил с новым подходом.

Кроме того, я использую CreateFile API-интерфейс тоже. VBA-это своего рода медленная запись файлов, это помогло немного с скорости тоже. В целом, я получил расщепление и пишет 130 МБ файл в менее чем 2 секунд (~1.89 секунды).

Пересмотренный Кодекс

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

3
ответ дан 21 февраля 2018 в 11:02 Источник Поделиться

Вы спрашивали за работу и я думаю, что вы получили прекрасный ответ от @Райан Wildry. Этот ответ просто устраняет другие улучшения кода.

Тип

Начну с верхней части модуля -


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


Я считаю себя немного больше, чем новичок в VBA, но мне пришлось посмотреть объектную модель Excel, чтобы выяснить это. Мне кажется, это будет лучше как класс.

И Private декларация на модуль уровня там нет, так что при переходе через SplitLargeFiles суб, использование With File мне интересно, если вы используете по умолчанию объект неявно, что я не знал. Это, как говорится, почему File объявленные на уровне модуля, когда он используется только одна процедура?

Вы действительно бросили меня для петли есть.


Переменные


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

Мне нравится, что вы знали, что должны дать каждой переменной тип при объявлении их на линию. Я тоже думаю, ваши имена переменных будут довольно хорошие. Но newFile как строка является своего рода запутанным, особенно с вашим типом вверху. Я бы также бросить в const для некоторых из этих магических чисел и строк

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

Сейчас, кажется, будет нужно изменить некоторые вещи внизу. Но я не хочу забегать вперед.


Комментарии

Вы можете увидеть некоторые мои имена переменных, что единственный способ я знаю, что мне захочется назвать с комментариями. Как 'specific tweak to data.

Комментарии - "код сказать вам, как, комментарии, скажу вам, почему". Код должен говорить сам за себя, если он нуждается в комментариях, его нужно сделать более четким. Если нет, то комментарий должен описывать , почему вы делаете что-то, а не как ты делаешь это. Вот несколько причин , чтобы избежать замечаний все вместе.


Структура Кода

Скелетон -


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

Неудивительно, что спектакль происходит удар, у вас есть три j петли в одну i петли в один цикл.

Почему В Excel

Когда вы смотрите на это таким образом, вы можете видеть всех этих циклов , что вы собираетесь через каждый File.Name. Я не собираюсь говорить тебе, что делать, но почему вы делите .sql файлы с VBA для Excel? Я думаю, что они представляют собой таблицы или даже .CSV, но я не могу представить VBA для Excel является способом пойти. Может быть, вы делаете то, что вы можете с тем, что у вас есть, и нет ничего плохого в том, что на самом деле. Но я не вижу никаких ...


  • Диапазон

  • Клетки

  • Лист

  • Книга

Все, что я действительно вижу одну функцию листа. На вершине, что, это то, что вы работаете с

Вежливость Rubberduck-ВБА
enter image description here

Важное замечание!

Пожалуйста, не принимайте это, как я унижаю тебя или твои работы! Вы сделали что-то, что делает то, что вам было нужно и вы сделали это таким образом, что вы знали. Несмотря ни на что, это замечательно. Вот почему ты здесь на ревью кода и не так, потому что вы хотите стать лучше в этом.

Я знаю, это может быть подавляющим, чтобы получить код ковырялись. Иногда вы не можете даже принять все это сразу, вы в конечном итоге сделать некоторые хитрости и возвращаешься только за тем, чтобы в конечном итоге с некоторыми из тех же отзывов. Это Природа зверя.


Рефакторинг

Когда вы повторяете себе снова и снова (как с теми петлями), вы могли бы извлечь выгоду от оптимизации кода. Это само по себе не обязательно является повышение производительности, но это, безусловно, делает внешний вид лучше.

В свой первый If мы можем разорвать его

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

И мы можем разделить, что из

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

и так далее.

Это только примеры, не принимая во внимание то, что переменные должны быть переданы и не называя их. Я не обратился за все , что он делает, просто структура делает его.


3
ответ дан 21 февраля 2018 в 11:02 Источник Поделиться

Большинство потраченное время загрузки данных в массив. Путем замены Split функция с моим getTextFileLines функции, я был в состоянии сократить время, которое потребовалось, чтобы загрузить массив из 64.41 seconds для 6.55 seconds. Общее время сократилось с 83.71 seconds для 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

Использование

'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

Замените код ↑выше↑ с кодом ↓ниже↓

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

Добавление: Лучший Способ

Это беспокоит меня, так это заняло больше времени, чтобы читать текстовые файлы содержимое в строку, потом потребовалось, чтобы прочитать файл построчно в массив. Проблема была в том, что я использую input(LOF(1), #FileBumber) что является не самым эффективным способом.

Правильный подход заключается в создании буфера. Вы первый буфер строку с пробелами, равное количеству символов в файле. Далее вы использовать Get функция для заполнения буфера с файлом данных. Это заняло 0.64 сек файл 130 МБ.

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

SQLFileSplitter: Класс

Я создал SQLFileSplitter класс, чтобы упростить процесс.

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

Этот код разделить 130 МБ файл в 6.33 секунд

2
ответ дан 22 февраля 2018 в 02:02 Источник Поделиться