Функции ChangeFileCharset и ChangeTextCharset предназначены для изменения кодировки символов в текстовых файлах и строках. Исходную и конечную (желаемую) кодировку можно задать в параметрах вызова функций. Список доступных на вашем компьютере кодировок можно найти в реестре Windows в ветке Среди доступных кодировок есть koi8-r, ascii, utf-7, utf-8, Windows-1250, Windows-1251, Windows-1252, и т.д. и т.п. Определить исходную и конечную кодировку можно, воспользовавшись онлайн-декодером: 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
|
|||
Комментарии
Попробуйте закомментировать строку On Error Resume Next в моей функции.
Если при этом макрос остановится с ошибкой - вы сразу обнаружите её причину, посмотрев значение передаваемой функции переменной.
PS: У меня совершенно нет опыта работы с Access - так что, возможно, причина и в вашем коде.
Для тестирования я бы заменил строку ns = ChangeTextCharset(ss, "UTF-8", "Windows-1251")
следующим кодом:
ns = ChangeTextCharset(ss, "UTF-8", "Windows-1251")
debug.print "After: ", ns
Потом в окне Immediate изучить результат - и всё станет понятно.
Спасибо! Работает хорошо.
Но умення вопрос...
В цикле Do ... Loop назначает новую кодировку на первою строку, а все остальные остаются в исходной кодировке. Пример:
Dim ss As String
Dim ns As String
Dim st As ADODB.Recordset
Set st = New ADODB.Recordset
With st
.Open "NoteWE", CurrentProject.Connection, adOpenStatic, adLockPessimistic
.MoveFirst
End With
Dim nt As ADODB.Recordset
Set nt = New ADODB.Recordset
With nt
.Open "Клев", CurrentProject.Connection, adOpenStatic, adLockPessimistic
End With
' вызываем функцию ChangeTextCharset с указанием кодировок
Do Until st.EOF
ss = st(0).Value
ns = ChangeTextCharset(ss, "UTF-8", "Windows-1251")
nt.AddNew
nt.Fields(1) = ns
nt.Update
st.MoveNext
Loop
В чем я ошибся?
Зарание спасибо
Круто!!!
Спасибо, вчера весь день искал... ничего не помогло...
Только эта статья помогла...
Отправить комментарий