mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Макрос создания текстовых файлов по данным из первого столбца

Sub СозданиеТекстовыхФайлов()
    On Error Resume Next: Dim cell As Range, ra As Range
    Set FSO = CreateObject("scripting.filesystemobject")
    BaseFolder$ = ThisWorkbook.Path & "\Папка\": MkDir BaseFolder$    ' создаём  папку

    For Each cell In Range([A1], Range("A" & Rows.Count).End(xlUp)).Cells
        filename$ = BaseFolder$ & cell.Row & ".txt"
        Set ts = FSO.CreateTextFile(filename$, True, True)
        ts.Write cell.Value: ts.Close
        ChangeFileCharset filename$, "utf-8"    ' если текстовый файл нужен в другой кодировке
    Next cell
    Set ts = Nothing: Set FSO = Nothing
    CreateObject("wscript.shell").Run "explorer.exe /e, """ & BaseFolder$ & """"    ' открываем папку с файлами
End Sub
 
Function ChangeFileCharset(ByVal filename$, ByVal DestCharset$, _
                           Optional ByVal SourceCharset$) As Boolean
    ' функция перекодировки (смены кодировки) текстового файла
    ' В качестве параметров функция получает путь filename$ к текстовому файлу,
    ' и название кодировки DestCharset$ (в которую будет переведён файл)
    ' Функция возвращает TRUE, если перекодировка прошла успешно
    On Error Resume Next: Err.Clear
    With CreateObject("ADODB.Stream")
        .Type = 2
        If Len(SourceCharset$) Then .Charset = SourceCharset$    ' указываем исходную кодировку
        .Open
        .LoadFromFile filename$    ' загружаем данные из файла
        FileContent$ = .ReadText   ' считываем текст файла в переменную FileContent$
        .Close
        .Charset = DestCharset$    ' назначаем новую кодировку
        .Open
        .WriteText FileContent$
        .SaveToFile filename$, 2   ' сохраняем файл уже в новой кодировке
        .Close
    End With
    ChangeFileCharset = Err = 0
End Function

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

как весь диапазон вставить

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
   __     ____               _   _   _  _     _ 
/ /_ | _ \ __ __ | | | | | || | | |
| '_ \ | |_) | \ \ /\ / / | |_| | | || |_ | |
| (_) | | _ < \ V V / | _ | |__ _| | |
\___/ |_| \_\ \_/\_/ |_| |_| |_| |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

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