Функции ChangeFileCharset и ChangeTextCharset предназначены для изменения кодировки символов в текстовых файлах и строках.

Исходную и конечную (желаемую) кодировку можно задать в параметрах вызова функций.

ВНИМАНИЕ: Новая (универсальная) версия функции сохранения текста в файл в заданной кодировке:
http://excelvba.ru/code/SaveTextToFile

Список доступных на вашем компьютере кодировок можно найти в реестре Windows в ветке
HKEY_CLASSES_ROOT\MIME\Database\Charset

Среди доступных кодировок есть koi8-r, ascii, utf-7, utf-8, Windows-1250, Windows-1251, Windows-1252, и т.д. и т.п.

Определить исходную и конечную кодировку можно, воспользовавшись онлайн-декодером:
http://www.artlebedev.ru/tools/decoder/advanced/
(после преобразования снизу будет написано, из какой кодировки в какую переведён текст)

Sub ПримерИспользования_ChangeTextCharset()

    ИсходнаяСтрока = "бНОПНЯ"

    ' вызываем функцию ChangeTextCharset с указанием кодировок

    ' (меняем кодировку с KOI8-R на Windows-1251)

    ПерекодированнаяСтрока = ChangeTextCharset(ИсходнаяСтрока, "Windows-1251", "KOI8-R")

    MsgBox "Результат перекодировки: """ & ПерекодированнаяСтрока & """", _

           vbInformation, "Исходная строка: """ & ИсходнаяСтрока & """"

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

Function ChangeTextCharset(ByVal txt$, ByVal DestCharset$, _

                           Optional ByVal SourceCharset$) As String

    ' функция перекодировки (смены кодировки) текстовоq строки

    ' В качестве параметров функция получает текстовую строку txt$,

    ' и название кодировки DestCharset$ (в которую будет переведён текст)

    ' Функция возвращает текст в новой кодировке

    On Error Resume Next: Err.Clear

    With CreateObject("ADODB.Stream")

        .Type = 2: .Mode = 3

        If Len(SourceCharset$) Then .Charset = SourceCharset$    ' указываем исходную кодировку

        .Open

        .WriteText txt$

        .Position = 0

        .Charset = DestCharset$    ' назначаем новую кодировку

        ChangeTextCharset = .ReadText

        .Close

    End With

End Function

' Функция для перекодировки файла в UTF-8 без BOM (то же самое, что и UTF-8, только без первых 3 байтов)

Function ChangeFileCharset_UTF8noBOM(ByVal filename$, Optional ByVal SourceCharset$) As Boolean

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

    ' В качестве параметров функция получает путь filename$ к текстовому файлу,

    ' Функция возвращает TRUE, если перекодировка прошла успешно

    On Error Resume Next: Err.Clear

    DestCharset$ = "utf-8"

    With CreateObject("ADODB.Stream")

        .Type = 2

        If Len(SourceCharset$) Then .Charset = SourceCharset$        ' указываем исходную кодировку

        .Open

        .LoadFromFile filename$        ' загружаем данные из файла

        FileContent$ = .ReadText        ' считываем текст файла в переменную FileContent$

        .Close

        .Charset = DestCharset$        ' назначаем новую кодировку "utf-8"

        .Open

        .WriteText FileContent$

        'Write your data into the stream.

        Dim binaryStream As Object

        Set binaryStream = CreateObject("ADODB.Stream")

        binaryStream.Type = 1

        binaryStream.Mode = 3

        binaryStream.Open

        'Skip BOM bytes

        .Position = 3

        .CopyTo binaryStream

        .Flush

        .Close

        binaryStream.SaveToFile filename$, 2

        binaryStream.Close

    End With

    ChangeFileCharset_UTF8noBOM = Err = 0

End Function

Функция перекодировки текста в UTF-8 без BOM

Function EncodeUTF8noBOM(ByVal txt As String) As String

    For i = 1 To Len(txt)

        l = Mid(txt, i, 1)

        Select Case AscW(l)

            Case Is > 4095: t = Chr(AscW(l) \ 64 \ 64 + 224) & Chr(AscW(l) \ 64) & Chr(8 * 16 + AscW(l) Mod 64)

            Case Is > 127: t = Chr(AscW(l) \ 64 + 192) & Chr(8 * 16 + AscW(l) Mod 64)

            Case Else: t = l

        End Select

        EncodeUTF8noBOM = EncodeUTF8noBOM & t

    Next

End Function

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