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

Среди доступных кодировок есть 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

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