MyTetra Share
Делитесь знаниями!
Чтение файлов формата .txt в кодировке utf-8 - VBA
16.03.2019
23:43
Раздел: !Закладки - VBA - Разобрать

Чтение файлов формата .txt в кодировке utf-8 - VBA

09.03.2017, 14:34. Просмотров 1211. Ответов 15

Метки excel, кодировка, макрос (Все метки)


Уважаемые форумчане!

Делаю скрипт для чтения и записи txt-файлов из Excel-вского файла по средствам VBA макросов.
Но всё упёрлось в проблему с кодировкой. Мне по умолчанию нужна UTF-8, так как она удобнее и файлы с которыми будет работать скрипт будут именно в ней.
Взял за основу для чтения и записи такой скрипт:


Visual BasicВыделить код

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» вроде как в холостую, хотя по идеи надо как то обработать ошибку..






Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования