Vba перекодировка из utf 8 в windows 1251

Смена кодировки строки с UTF-8 на ANSI (Windows-1251) и преобразование кодировки текста ANSI (Windows-1251) в UTF-8.

Перекодировка строки с UTF-8 в ANSI (Windows-1251) может понадобиться в VBA, например, при загрузке данных из CSV-файла с кодировкой UTF-8 на рабочий лист книги Excel.

Изменение кодировки текста UTF-8 на ANSI (Windows-1251) для 32-разрядных платформ:

Private Declare Function MultiByteToWideChar Lib «kernel32.dll» (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long Function FromUTF8(ByVal sText As String) As String Dim nRet As Long, strRet As String     strRet = String(Len(sText), vbNullChar)     nRet = MultiByteToWideChar(65001, &H0, sText, Len(sText), StrPtr(strRet), Len(strRet)) FromUTF8 = Left(strRet, nRet) End Function

Пример перекодировки строки с UTF-8 в ANSI (Windows-1251):

Sub Primer() Dim num1 As Integer, a1 As String, str1 As String     ‘Выбираем файл CSV с кодировкой UTF-8     a1 = Application.GetOpenFilename(«Текст с разделителями,*.csv», , «Выбор файла»)         If Right(a1, 4) <> «.csv» Then Exit Sub     ‘Открываем файл и считываем текст в переменную     num1 = FreeFile         Open a1 For Input As num1             str1 = Input(LOF(num1), num1)         Close num1     ‘Меняем кодировку с UTF-8 на Windows-1251     str1 = FromUTF8(str1)     ‘Работаем с текстом и вставляем нужные значения на рабочий лист End Sub

Преобразование кодировки ANSI в UTF-8

Изменение кодировки текста ANSI (Windows-1251) на UTF-8 для 32-разрядных платформ:

Private Declare Function WideCharToMultiByte Lib «kernel32.dll» (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, ByVal lpUsedDefaultChar As Long) As Long Function ToUTF8(ByVal sText As String) As String Dim nRet As Long, strRet As String     strRet = String(Len(sText) * 2, vbNullChar)     nRet = WideCharToMultiByte(65001, &H0, StrPtr(sText), Len(sText), StrPtr(strRet), Len(sText) * 2, 0&, 0&)     ToUTF8 = Left(StrConv(strRet, vbUnicode), nRet) End Function

Пример перекодировки строки с ANSI (Windows-1251) в UTF-8:

Изменение кодировки в 64-разрядных системах

Если у вас 64-разрядная версия VBA Excel, добавьте ключевое слово PtrSafe после оператора Declare и замените тип данных Long на LongPtr:

Private Declare PtrSafe Function MultiByteToWideChar Lib «kernel32.dll» (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, ByVal lpMultiByteStr As String, ByVal cchMultiByte As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr) As LongPtr Private Declare PtrSafe Function WideCharToMultiByte Lib «kernel32.dll» (ByVal CodePage As LongPtr, ByVal dwFlags As LongPtr, ByVal lpWideCharStr As LongPtr, ByVal cchWideChar As LongPtr, ByVal lpMultiByteStr As LongPtr, ByVal cchMultiByte As LongPtr, ByVal lpDefaultChar As LongPtr, ByVal lpUsedDefaultChar As LongPtr) As LongPtr

В среде разработки VBA 7 тип данных LongPtr на 32-разрядных платформах интерпретируется как Long, а в 64-разрядных — как LongLong.

---

Ну положим, пишет в одну ячейку не скрипт, а Вы — что Вы ему сказали делать, то и делает…  
Я думал, сообразите или найдёте пример, куда этот text далее направить.  

  Например, вот готовый код по преобразованию текста. Тут всё есть. Вам нужна вторая, третья и последние три строки:  

  Const ForReading = 1  
Const ForWriting = 2  

  Set objFSO = CreateObject(«Scripting.FileSystemObject»)  
Set objFile = objFSO.OpenTextFile(«c:\test.txt», ForReading)  

  strText = objFile.ReadAll  
objFile.Close  

  strText = Replace(strText, «,», » «)  
strText = Replace(strText, «»»», » «)  

  Set objFile = objFSO.OpenTextFile(«c:\test.txt», ForWriting)  
objFile.Write strText  
objFile.Close  

  А кстати вариант с OLEPRNLib мне нравится больше. В ХР содержится изначально, про другие не знаю.

Функции 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 просмотров