|
Функции 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
|
