Excel vba кодировка файла

1
2
3
4
5
6
7
8
9
10
11
12
13

Sub Test()
    ' Запись в файл
    Open "D:tmpfile.txt" For Output As #1
    Print #1, "My name is Петя!"
    Close #1
  
    ' Чтение из файла
    Open "D:tmpfile.txt" For Input As #1
    Dim s As String
    Input #1, s
    MsgBox s
    Close #1
End Sub

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

1

ChangeFileCharset "C:/file.txt",  "Windows-1251", "UTF-8"

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:TMP1.txt", "Windows-1251", "UTF-8"
 
End Sub

1

ChangeFileCharset "C:/file.txt",  "UTF-8", "Windows-1251"

1

ChangeFileCharset "D:TMP1.txt", "UTF-8", "UTF-8"

1
2
3
4
5
6
7
8

    ' Чтение из файла
    Open "D:tmpfile.txt" For Input As #1
    Dim s As String
    Input #1, s
    ' Функция д/правильного перекодировки «s»   
    ' Произвольный код д/обработки «s»
    MsgBox s
    Close #1

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:tmpfile.txt" For Output As #1
    ' Print #1, "My name is Петя!"
    ' Close #1
  
    ' Чтение из файла
    Open "C:tmpfile.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

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:tmpfile.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:tmpfile.txt")
    Open "d:tmpfile.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

1
2
3
4
5
6
7
8
9
10
11

Sub Test()
    Dim  xx() As Byte
    xx = "My name is Петя!"
    Open "d:tmpfile.txt" For Binary As #1
        Put #1, , xx
    Close #1
    Open "d:tmpfile.txt" For Binary As #1
        Get #1, , xx
    Close #1
    MsgBox xx
End Sub

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

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:TMP1.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

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

Function exChangeContent(ByVal str$, ByVal pth$, ByVal chI$, Optional ByVal chO$) As String
   ' функция перекодировки (смены кодировки) текстового файла
   ' pth$ - путь к текстовому файлу с названием файла.расширение,
   ' chI$ кодировка в которой перевести для принятия файла
   ' ? Функция возвращает TRUE, если перекодировка прошла успешно
   On Error Resume Next: Err.Clear
    With CreateObject("ADODB.Stream")
 
 
        .Type = 2
        If Len(chO$) Then .Charset = chO$    ' указываем исходную кодировку
       .Open
        .LoadFromFile pth$   ' загружаем данные из файла
       FileContent$ = .ReadText   ' считываем текст файла в переменную FileContent$
       .Close
       
'   Блок кода, чтобы записать значение в файл
'       .Charset = chI$   ' назначаем новую кодировку
'        .Open
'      .WriteText str$
'       .SaveToFile pth$, 2  ' сохраняем файл уже в новой кодировке
'      .Close
 
    End With
    
 
    exChangeContent = FileContent$    
 
End Function
 
Sub TEST()
 
Dim str As String  'Текст для записи в файл.
Dim pth As String  'Путь к файлу + имя.расширение
Dim chI As String  'Кодировка входящего текста
Dim chO As String
 
' Значения по умолчанию
str = "Текстовый файлик"    ' Значение по-умолчанию
pth = "D:tmpрусский.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