|
Sub Test()
' Запись в файл
Open "D:\tmp\file.txt" For Output As #1
Print #1, "My name is Петя!"
Close #1
' Чтение из файла
Open "D:\tmp\file.txt" For Input As #1
Dim s As String
Input #1, s
MsgBox s
Close #1
End Sub
|
Visual BasicВыделить код |
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 |
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 | |
|
Добавлено через 2 минуты
|
Visual BasicВыделить код |
|
1 |
ChangeFileCharset "C:/file.txt", "Windows-1251", "UTF-8" | |
|
спасибо за помощь, к сожалению при испытании этого кода, ничего не получилось:
|
Visual BasicВыделить код |
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27 |
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
Sub TEST()
ChangeFileCharset "E:\TMP\1.txt", "Windows-1251", "UTF-8"
End Sub | |
|
Файл пересохраняется, но обработка происходит некорретно. В исходный файл 1.txt записывал строку "My name is Петя". Сам файл сохранил в 1251 (и в UTF 8) - возвращает что то вроде «My name is ????» или «My name is Ïåòÿ» и т.п (в зависимости от вариации. Но никакая не позволила определить, что к чему.
Я вот ещё думаю... Сам редактор VBA не может настраиваться, как скажем другие текстовые редакторы скажем в Notepad++ можно же кодировку менять.. Хотя конечно врятли... Просто заметил, что даже когда просто копируешь из VBA-редактора текст в буфер и вставляешь в блокнот, то сразу вылезают кракозяблы.?!
Попробуйте поменять местами
|
Visual BasicВыделить код |
|
1 |
ChangeFileCharset "C:/file.txt", "UTF-8", "Windows-1251" | |
|
На вскидку могу предложить что-то подобное.
Но с первым байтом нужно что-то делать.
|
Visual BasicВыделить код |
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25 |
Sub Test()
' Запись в файл
' Open "C:\tmp\file.txt" For Output As #1
' Print #1, "My name is Петя!"
' Close #1
' Чтение из файла
Open "C:\tmp\file.txt" For Input As #1
Dim s As String
Input #1, s
Close #1
MsgBox UTF8ToANSI(s)
End Sub
Public Function UTF8ToANSI(ByVal UTF8 As String) As String
Dim UTF8Chars() As String, i As Long
UTF8Chars = UTF8Chr
For i = 128 To 255
UTF8 = Replace(UTF8, UTF8Chars(i - 128), Chr(i))
Next i
UTF8ToANSI = UTF8
End Function
Public Function UTF8Chr()
UTF8Chr = Split("Р‚&&Рѓ&&‚&&С“&&„&&…&&вЂ*&&‡&&€&&‰&&Р‰&&‹&&РЉ&&РЊ&&Р‹&&РЏ&&С’&&вЂЛњ&&’&&“&&”&&•&&–&&—&&ВЛњ&&в„ў&&С™&&›&&Сљ&&Сњ&&С›&&Сџ&&В*&&РЋ&&Сћ&&Р€&&В¤&&Тђ&&В¦&&В§&&РЃ&&В©&&Р„&&В«&&В¬&&В*&&В®&&Р‡&&В°&&В±&&Р†&&С–&&Т‘&&Вµ&&В¶&&В·&&С‘&&в„–&&С”&&В»&&СЛњ&&Р…&&С•&&С—&&Рђ&&Р‘&&Р’&&Р“&&Р”&&Р•&&Р–&&Р—&&РЛњ&&Р™&&Рљ&&Р›&&Рњ&&Рќ&&Рћ&&Рџ&&Р*&&РЎ&&Рў&&РЈ&&Р¤&&РҐ&&Р¦&&Р§&&РЁ&&Р©&&РЄ&&Р«&&Р¬&&Р*&&Р®&&РЇ&&Р°&&Р±&&РІ&&Рі&&Рґ&&Рµ&&Р¶&&Р·&&Рё&&Р№&&Рє&&Р»&&Рј&&РЅ&&Рѕ&&Рї&&СЂ&&СЃ&&С‚&&Сѓ&&С„&&С…&&С†&&С‡&&С€&&С‰&&СЉ&&С‹&&СЊ&&СЌ&&СЋ&&СЏ", "&&")
End Function | |
|
0
|
Visual BasicВыделить код |
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18 |
Function ChangeTextCharset(ByVal txt$, ByVal DestCharset$, _
Optional ByVal SourceCharset$) As String
' функция перекодировки (смены кодировки) текстовой строки
' В качестве параметров функция получает текстовую строку 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 | |
|
Кривой вариант немного
|
Visual BasicВыделить код |
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31 |
Sub Test()
Dim s As String
Dim x() As Byte, xx() As Byte
Dim i As Long, y As Long
Dim ii As Long
Open "d:\tmp\file.txt" For Binary As #1
s = "My name is Петя!"
x = StrConv(s, vbUnicode)
y = UBound(x)
ReDim xx(0 To y \ 2)
ii = 0
For i = 0 To y Step 2
xx(ii) = x(i)
ii = ii + 1
Next i
Put #1, , xx
Close #1
y = FileLen("d:\tmp\file.txt")
Open "d:\tmp\file.txt" For Binary As #1
ReDim xx(0 To y - 1)
ReDim x(0 To 2 * (y - 1))
Get #1, , xx
ii = 0
For i = 0 To 2 * (y - 1) Step 2
x(i) = xx(ii)
ii = ii + 1
Next i
s = StrConv(x, vbFromUnicode)
MsgBox s
Close #1
End Sub | |
|
Добавлено через 16 часов 16 минут
Этот вариант более эстетичный
|
Visual BasicВыделить код |
|
1
2
3
4
5
6
7
8
9
10
11 |
Sub Test()
Dim xx() As Byte
xx = "My name is Петя!"
Open "d:\tmp\file.txt" For Binary As #1
Put #1, , xx
Close #1
Open "d:\tmp\file.txt" For Binary As #1
Get #1, , xx
Close #1
MsgBox xx
End Sub | |
|
воспользовавшись примером, получилось нечто такое..
Функция для обмена данными с файлом
|
Visual BasicВыделить код |
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 |
Function exChangeContent(ByVal str$, ByVal filename$, ByVal DestCharset$, Optional ByVal SourceCharset$) As String
' функция перекодировки (смены кодировки) текстового файла
' В качестве параметров функция получает путь 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 str$
.SaveToFile filename$, 2 ' сохраняем файл уже в новой кодировке
.Close
End With
' exChangeContent = FileContent$ ' обменяет знач.ячейки с содержимым файла
exChangeContent = ActiveCell.Value ' вернёт текущее значение ячейки
End Function | |
|
и такая процедура, для запуска
|
Visual BasicВыделить код |
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22 |
Sub TEST()
Dim str As String 'Текст для записи в файл.
Dim pth As String 'Путь к файлу + имя.расширение
Dim chI As String 'Кодировка входящего текста
Dim chO As String 'Кодировка исходящего текста
' Значения по умолчанию
str = "Текстовый файлик"
pth = "E:\TMP\1.txt"
chI = "UTF-8"
chO = "UTF-8"
' Берём путь к файлу из соседней ячейки справа от выделенной
If Len(ActiveCell.Offset(0, 1).Value) Then pth = ActiveCell.Offset(0, 1).Value
str = ActiveCell.Text
ActiveCell.Value = exChangeContent(str, pth, chI, chO)
End Sub | |
|
скрипт рабочий. В принципе необходимые задачи решает. Только получается что «On Error Resume Next: Err.Clear» вроде как в холостую, хотя по идеи надо как то обработать ошибку..
|
|
