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

Функция сохранения текста в файл, в заданной кодировке

Функция создаёт на диске текстовый файл в заданной кодировке.

Среди доступных кодировок есть koi8-r, ascii, utf-7, utf-8, utf-8noBOM, utf-16, Windows-1251, unicode, и т.д.
Список доступных кодировок можно найти в реестре Windows, в ветке HKEY_LOCAL_MACHINE\SOFTWARE\Classes\MIME\Database\Charset

Function SaveTextToFile(ByVal txt$, ByVal filename$, Optional ByVal encoding$ = "windows-1251") As Boolean
    ' функция сохраняет текст txt в кодировке Charset$ в файл filename$
    On Error Resume Next: Err.Clear
    Select Case encoding$
 
        Case "windows-1251", "", "ansi"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(filename, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing
 
        Case "utf-16", "utf-16LE"
            Set FSO = CreateObject("scripting.filesystemobject")
            Set ts = FSO.CreateTextFile(filename, True, True)
            ts.Write txt: ts.Close
            Set ts = Nothing: Set FSO = Nothing
 
        Case "utf-8noBOM"
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = "utf-8": .Open
                .WriteText txt$
 
                Set binaryStream = CreateObject("ADODB.Stream")
                binaryStream.Type = 1: binaryStream.Mode = 3: binaryStream.Open
                .Position = 3: .CopyTo binaryStream        'Skip BOM bytes
                .flush: .Close
                binaryStream.SaveToFile filename$, 2
                binaryStream.Close
            End With
 
        Case Else
            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = encoding$: .Open
                .WriteText txt$
                .SaveToFile filename$, 2        ' сохраняем файл в заданной кодировке
                .Close
            End With
    End Select
    SaveTextToFile = Err = 0: DoEvents
End Function

PS: Функция является расширенной (универсальной) версией функций из этой статьи:
http://excelvba.ru/code/encode

А вот функция для чтения текстового файла в заданной кодировке:

Function LoadTextFromTextFile(ByVal filename$, Optional ByVal encoding$) As String
    ' функция загружает текст в кодировке Charset$ из файла filename$
    On Error Resume Next: Dim txt$
    If Trim(encoding$) = "" Then encoding$ = "windows-1251"
    With CreateObject("ADODB.Stream")
        .Type = 2:
        If Len(encoding$) Then .Charset = encoding$
        .Open
        .LoadFromFile filename$        ' загружаем данные из файла
        LoadTextFromTextFile = .ReadText        ' считываем текст файла
        .Close
    End With
End Function

Комментарии

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

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

Функция вызывается не так

LoadTextFromTextFile(ByVal filename$, Optional ByVal encoding$)

а так

LoadTextFromTextFile filename$, encoding$

Не эксперт в VBA. Есть вопрос - каким образом правильно вызвать функции?
Если вот так

Sub sss ()

With ActiveWorkbook.WebOptions
.RelyOnCSS = True
.OrganizeInFolder = True
.UseLongFileNames = True
.DownloadComponents = False
.RelyOnVML = False
.encoding = msoEncodingUTF8

End With

AD = ActiveWorkbook.Path & "\" & "led001.csv"

ActiveWorkbook.SaveAs filename:= _
AD, FileFormat:=xlCSV, CreateBackup:=False, Local:=True

encoding$ = "windows-1251"
filename$ = AD
LoadTextFromTextFile(ByVal filename$, Optional ByVal encoding$)

End Sub

выдает ошибку.

https://s.mail.ru/HHBf/GrzfCKfRR

Если надо делать поиск в файле, то результат LoadTextFromTextFile передавать в переменную типа String или выводить на лист и там уже искать? Спасибо

Просто, как все гениальное. Спасибо автору

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

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

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

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