Макрос предназначен для создания текстовых файлов в кодировке UTF-8.

Исходными данными является таблица Excel из 12 столбцов.

Сначала, макрос создаёт папку для будущих текстовых файлов.
Папка создаётся в том же каталоге, где расположена книга Excel.

Далее, для каждой строки таблицы, макрос формирует подпапку,
используя в качестве её названия текст из 7-го столбца таблицы.

И потом, когда папка для файла создана, макрос создаёт текстовый файл с содержимым из 10 столбца таблицы,
и сохраняет его под именем, взятым из второго столбца той же таблицы Excel.
После создания файла, у него меняется кодировка на UTF-8 (изначально, при создании, файлы имеют кодировку Unicode)

По окончании работы макроса, открывается папка, содержащая созданные текстовые файлы.

Пример макроса смотрите в прикреплённом файле.

Код макроса, создающего папки, подпапки, и текстовые файлы по данным из таблицы Excel:

Sub СозданиеТекстовыхФайлов()

    On Error Resume Next

    Dim cell As Range, ra As Range

    Set ra = Range([A2], Range("A" & Rows.Count).End(xlUp)).Resize(, 11)

    arr = ra.Value    ' считываем данные в массив

    Set FSO = CreateObject("scripting.filesystemobject")

    ' создаём главную папку

    BaseFolder$ = ThisWorkbook.Path & "\Товар по группам\": MkDir BaseFolder$

    ' перебираем все строки

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

        ' создаём папку для очередной строки (если папки ещё нет)

        Folder$ = BaseFolder$ & arr(i, 7) & "\"    ' имя папки - в столбце G

        MkDir Folder$

        ' формируем имя создаваемого текстового файла

        Filename$ = Folder$ & Trim(arr(i, 2)) & ".txt"

        ' создаём файл в кодировке Unicode

        Set ts = FSO.CreateTextFile(Filename$, True, True)

        ts.Write Trim(arr(i, 10))    ' данные в файл - из ячейки 10-го столбца

        ts.Close

        ' если текстовый файл нужен в другой кодировке

        ChangeFileCharset Filename$, "utf-8"

    Next i

    Set ts = Nothing: Set FSO = Nothing

    MsgBox "Файлы созданы, и помещены в папку" & vbNewLine & BaseFolder$, vbInformation, "Готово"

    ' открываем папку с файлами

    CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """"

End Sub

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