Функция предназначена для разбивки текстового файла на несколько файлов меньшего размера - в каждом из которых будет не более заданнного количества строк

Разделитель строк (обычно это перевод строки - константа vbNewLine) задаётся в качестве параметра функции Delimiter$

Создаваемые файлы получают имена вида filename(1).txt, filename(2).txt и т.д.

Если задан параметр функции DeleteSourceFile равным TRUE, - то исходный файл удаляется после разделения

Функция возвращает коллекцию, содержащую пути к сформированным файлам

В начало каждого создаваемого файла дописывается строка заголовка - первая строка из исходного файла

Пример использования функции SplitTextFile:

Sub ПримерИспользованияФункции_SplitTextFile()

ИмяРазбиваемогоФайла$ = "C:\test\2011 04 17 12-32-30.csv"

МаксимальноеКоличествоСтрокВфайле& = 3

Dim СписокИмёнФайлов As Collection

Set СписокИмёнФайлов = SplitTextFile(ИмяРазбиваемогоФайла$, МаксимальноеКоличествоСтрокВфайле&, vbNewLine, False)

For Each Файл In СписокИмёнФайлов

Debug.Print "Создан файл: " & Файл

Next

End Sub

Результат работы примера (из окна Immediate редактора VBA)

Создан файл: C:\test\2011 04 17 12-32-30(1).csv
Создан файл: C:\test\2011 04 17 12-32-30(2).csv
Создан файл: C:\test\2011 04 17 12-32-30(3).csv

Код функции SplitTextFile:

Function SplitTextFile(ByVal filename$, ByVal MaxRowsCount&, ByVal Delimiter$, _

Optional ByVal DeleteSourceFile As Boolean = True) As Collection

' функция предназначена для разбивки текстового файла filename$ на несколько файлов

' меньшего размера - в каждом из которых будет не более MaxRowsCount& строк

' Разделение строк выполняется с использованием разделителя Delimiter$

' Создаваемые файлы получают имена вида filename(1).txt, filename(2).txt и т.д.

' Если DeleteSourceFile = TRUE, - то исходный файл удаляется после разбивки

' Возвращает коллекцию имён созданных файлов

ext$ = "." & Split(filename$, ".")(UBound(Split(filename$, ".")))

Set fso = CreateObject("scripting.filesystemobject")

Set ts = fso.OpenTextFile(filename, 1, True): txt = ts.ReadAll: ts.Close

HeaderRow$ = Split(txt, Delimiter$, 2)(0) & Delimiter$ ' берем первую строку из файла как заголовок

txt = Split(txt, Delimiter$, 2)(1) ' остаток текста - без строки заголовка

' удаляем разделители строк в конце текстовой строки (если таковые присутствуют)

While txt Like "*" & Delimiter$: txt = Left(txt, Len(txt) - Len(Delimiter$)): Wend

' RowsCount = UBound(Split(txt, Delimiter$)) + 1 ' количество текстовых строк в файле

FileIndex& = 1 ' индекс очередного создаваемого файла

arr = Split(txt, Delimiter$): rc = 0: Set SplitTextFile = New Collection

For i = LBound(arr) To UBound(arr)

rc = rc + 1

NewTXT$ = NewTXT$ & arr(i) & Delimiter$

If rc >= MaxRowsCount& Or i = UBound(arr) Then ' набрали достаточно строк для записи в файл

NewFilename$ = Mid(filename$, 1, Len(filename$) - Len(ext$)) & "(" & FileIndex & ")" & ext$

Set ts = fso.CreateTextFile(NewFilename$, True)

ts.Write HeaderRow$ & NewTXT$: ts.Close

SplitTextFile.Add NewFilename$

FileIndex& = FileIndex& + 1

rc = 0: NewTXT$ = ""

End If

Next i

Set ts = Nothing: Set fso = Nothing

If DeleteSourceFile Then Kill filename$ ' удаляем исходный файл, если DeleteSourceFile = TRUE

End Function

• 21868 просмотров