MyTetra Share
Делитесь знаниями!
Изменение кодировки текстового файла - VBA2
Время создания: 31.07.2019 22:37
Текстовые метки: кодировки
Раздел: !Закладки - VBA
Запись: xintrea/mytetra_db_adgaver_new/master/base/15205892720xge808qeh/text.html на raw.githubusercontent.com
Наверняка есть готовые решения по конвертации кодировок, но я, из интереса, попробовал сделать на VB. В макросе есть ограничения (это всего лишь рабочий набросок для проекта): 1)он конвертирует ascii коды и буквы кириллицы, остальные символы из расширенной таблицы не конвертирует, 2) при конвертации файла не проверяются региональные настройки кодовой страницы, а просто тупо идет преобразование из windows-1251 в utf-8.
При вызове процедуры указываете полный путь текстового файла в кодировке 1251 (или ansi) и результат будет в той же папке.

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

32

33

34

35

36

37

38

39

40

41

42

43

44



Sub CP1251ToUTF8(sSourceFile As String)

    Dim sTargetFile$

    Dim iFreeFile&, i&, iDec&

    Dim bSource() As Byte, bTarget() As Byte

    If Dir(sSourceFile) = "" Then MsgBox sSourceFile & " not exists": Exit Sub

    i = InStrRev(sSourceFile, ".")

    sTargetFile = Left(sSourceFile, i - 1) & "_ToUtf8" & Right(sSourceFile, Len(sSourceFile) - i   1)

    If Dir(sTargetFile) <> "" Then Kill sTargetFile

    iFreeFile = FreeFile

    Open sSourceFile For Binary As #iFreeFile

        ReDim bSource(1 To LOF(iFreeFile))

        Get #iFreeFile, , bSource

    Close #iFreeFile

    If bSource(1) = &HEF And bSource(2) = &HBB And bSource(3) = &HBF Then _

        MsgBox "Conversion not required": Exit Sub

    ReDim bTarget(1 To 3)

    bTarget(1) = &HEF

    bTarget(2) = &HBB

    bTarget(3) = &HBF

    For i = 1 To UBound(bSource)

        iDec = UBound(bTarget)

        Select Case bSource(i)

        Case 0 To 127

            ReDim Preserve bTarget(1 To iDec   1)

            bTarget(UBound(bTarget)) = bSource(i)

        Case 168, 184, 192 To 239

            ReDim Preserve bTarget(1 To iDec   2)

            bTarget(iDec   1) = 208

            bTarget(iDec   2) = 128   (63 And AscB(Chr$(bSource(i))))

        Case 240 To 255

            ReDim Preserve bTarget(1 To iDec   2)

            bTarget(iDec   1) = 209

            bTarget(iDec   2) = 128   (63 And AscB(Chr$(bSource(i))))

        Case 152, 160, 164, 166, 167, 169, 187

            ReDim Preserve bTarget(1 To iDec   2)

            bTarget(iDec   1) = 194

            bTarget(iDec   2) = 128   (63 And AscB(Chr$(bSource(i))))

        End Select

    Next i

    iFreeFile = FreeFile

    Open sTargetFile For Binary As #iFreeFile

        Put #iFreeFile, , bTarget

    Close #iFreeFile

End Sub


Добавлено через 25 минут
Да, и еще, в ворде имеются встроенные инструменты по изменению кодировки, поищите, вполне возможно что и найдете. Я сейчас сделать это не могу.

Добавлено через 19 секунд
Да, и еще, в ворде имеются встроенные инструменты по изменению кодировки, поищите, вполне возможно что и найдете. Я сейчас сделать это не могу.

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