Чтение текстового файла, и запись в файл в заданной кодировке

В этой статье представлены 3 функции для работы с текстовыми файлами:

  • Text_LoadFromFile - загружает текст из заданного файла
  • Text_SaveToFile - сохраняет текст в файл в нужной кодировке
  • ReturnCharset - получает кодировку заданного текстового файла


Среди доступных кодировок есть koi8-r, ascii, utf-7, utf-8, utf-8noBOM, utf-16, Windows-1251, unicode, и т.д.
Под кодировкой utf-8noBOM подразумевается utf-8 без BOM (без трёх стартовых байтов 0xEF, 0xBB, 0xBF)
Список доступных кодировок можно найти в реестре Windows, в ветке HKEY_LOCAL_MACHINE\SOFTWARE\Classes\MIME\Database\Charset

Для начала — пример использования функций:

Sub Example_ReadAndWriteTextFile()
    Dim file$, txt$, enc$
 
    ' полный путь к текстовому файлу
    file$ = "C:\Windows\win.ini"
 
    ' получаем кодировку файла (необязательно)
    enc$ = ReturnCharset(file$)
 
    ' считываем текст из файла
    txt$ = Text_LoadFromFile(file$)
 
    ' добавляем строку в начало текста
    txt$ = "; это добавленная строка" & vbNewLine & txt
 
    ' записываем обратно в файл (кодировка файла не изменится)
    Text_SaveToFile txt$, file$, enc$
 
    ' проверяем, был ли добавлен текст
    txt$ = Text_LoadFromFile(file$)
    MsgBox Left(txt, 200), , "Кодировка: " & enc
End Sub

Sub Example_ReadTextFilesOnDesktop()
    Dim folder$, sFiles, txt$, enc$, item
    ' путь к папке РАБОЧИЙ СТОЛ
    folder$ = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
 
    sFiles = Dir(folder$ & "*.txt*")
    Do While sFiles <> "" ' перебираем файлы в папке
    
        item = folder$ & sFiles ' полный путь к файлу
        enc$ = ReturnCharset(item) ' получаем кодировку файла
        txt$ = Text_LoadFromFile(item) ' считываем текст из файла
        
        ' выводим данные о файле (размер в байтах, кодировка, имя файла)
        Debug.Print "Размер: " & FileLen(item), "Кодировка: " & enc$, sFiles
        Debug.Print "    Текст: " & Replace(Replace(Left(txt$, 50), vbCr, " "), vbLf, " ")
        sFiles = Dir
    Loop
End Sub

Код функций для работы с текстовыми файлами:

Function Text_LoadFromFile(ByVal Filename$, Optional ByVal Encoding$) As String
    ' функция загружает текст в кодировке Encoding$ из файла filename$
    ' © 2022 ExcelVBA.ru
    On Error Resume Next: Dim FSO, ts
    If Encoding$ = "" Then Encoding$ = ReturnCharset(Filename$)
    If Encoding$ = "ANSI" Then Encoding$ = "windows-1251"
    If Encoding$ = "UTF-8noBOM" Then Encoding$ = "UTF-8"
 
    If Encoding$ = "windows-1251" Then ' так НАМНОГО быстрее считываются большие файлы
        Set FSO = CreateObject("scripting.filesystemobject")
        Set ts = FSO.OpenTextFile(Filename$, 1, True): Text_LoadFromFile = ts.ReadAll: ts.Close
        Set ts = Nothing: Set FSO = Nothing: Exit Function
    End If
 
    With CreateObject("ADODB.Stream")
        .Type = 2:    If Len(Encoding$) Then .charset = Encoding$
        .Open:        .LoadFromFile Filename$
        Text_LoadFromFile = .ReadText: .Close
    End With
End Function
 
Function Text_SaveToFile(ByVal txt$, ByVal Filename$, Optional ByVal Encoding$) As Boolean
    ' функция сохраняет текст txt в кодировке Encoding$ в файл filename$
    ' возвращает TRUE, если сохранение прошло успешно
    ' © 2022 ExcelVBA.ru
    On Error Resume Next: Err.Clear
    If Encoding$ = "ANSI" Then Encoding$ = "windows-1251"
    If Encoding$ = "" Then Encoding$ = "UTF-8" ' кодировка по умолчанию: UTF-8
    
    Select Case Encoding$
        Case "utf-8noBOM"
            With CreateObject("ADODB.Stream")
                .Type = 2: .charset = "utf-8": .Open: .WriteText txt$
                Dim binaryStream As Object: Set binaryStream = CreateObject("ADODB.Stream")
                binaryStream.Type = 1: binaryStream.Mode = 3: binaryStream.Open
                .Position = 3: .CopyTo binaryStream        'Skip BOM bytes
                .flush: .Close
                binaryStream.SaveToFile Filename$, 2
                binaryStream.Close
            End With
 
        Case Else
            With CreateObject("ADODB.Stream")
                .Type = 2: .charset = Encoding$: .Open: .WriteText txt$
                .SaveToFile Filename$, 2: .Close
            End With
    End Select
    Text_SaveToFile = Err = 0: DoEvents
End Function
 
Function ReturnCharset(ByVal filePath As String) As String
    On Error Resume Next ' © 2022 ExcelVBA.ru
    Dim bytHeader(2) As Byte, txt$, lngFileNum As Long, fLen&
    lngFileNum = FreeFile
    If CreateObject("Scripting.FileSystemObject").FileExists(filePath) Then
        Open filePath For Binary Access Read As lngFileNum
        Get lngFileNum, , bytHeader ' first 3 bytes
        Close lngFileNum
    End If
 
    Select Case bytHeader(0)
        Case 255:   'UTF-16 (LE)   FF FE          255 254
            If bytHeader(1) = 254 Then ReturnCharset = "UTF-16LE" ' Unicode
        Case 254:   'UTF-16 (BE)   FE FF          254 255
            If bytHeader(1) = 255 Then ReturnCharset = "UTF-16BE" ' UnicodeBigEndian
        Case 239:   'UTF-8         EF BB BF       239 187 191
            If bytHeader(1) = 187 Then If bytHeader(2) = 191 Then ReturnCharset = "UTF-8"
        Case 43:   'UTF-7         2b 2f 76       43 47 118
            If bytHeader(1) = 47 Then If bytHeader(2) = 118 Then ReturnCharset = "UTF-7"
    End Select
    If ReturnCharset = "" Then
        fLen& = FileLen(filePath)
        ' для файлов более 2 МБ не уточняем тип файла, ибо это занимает много времени
        If fLen& > 2048000 Then ReturnCharset = "ANSI": Exit Function
        With CreateObject("ADODB.Stream")
            .Type = 2: .charset = "UTF-8":  .Open
            .LoadFromFile filePath    ' загружаем данные из файла
            txt$ = .ReadText
            ReturnCharset = IIf(Len(txt) < .Size - 3, "UTF-8noBOM", "ANSI")
            .Close
        End With
    End If
End Function

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

у меня файлы Excel сохраняются с "?" знаками вместо умлаутов.
Пожалуйста объясните подробно(пошагово)как это изменить.
Заранее благодарен.
P.S. WIN 10 установлен рускоязычный, затем язык системы заменён на немецкий.

Куда этот код в exel вписывать?

Отличные примеры, очень помогли, спасибо

Спасибо автору! В который раз уже выручает.

Функция вызывается не так

LoadTextFromTextFile(ByVal filename$, Optional ByVal encoding$)

а так

LoadTextFromTextFile filename$, encoding$

Не эксперт в VBA. Есть вопрос - каким образом правильно вызвать функции?
Если вот так

Sub sss ()

With ActiveWorkbook.WebOptions
.RelyOnCSS = True
.OrganizeInFolder = True
.UseLongFileNames = True
.DownloadComponents = False
.RelyOnVML = False
.encoding = msoEncodingUTF8

End With

AD = ActiveWorkbook.Path & "\" & "led001.csv"

ActiveWorkbook.SaveAs filename:= _
AD, FileFormat:=xlCSV, CreateBackup:=False, Local:=True

encoding$ = "windows-1251"
filename$ = AD
LoadTextFromTextFile(ByVal filename$, Optional ByVal encoding$)

End Sub

выдает ошибку.

https://s.mail.ru/HHBf/GrzfCKfRR

Если надо делать поиск в файле, то результат LoadTextFromTextFile передавать в переменную типа String или выводить на лист и там уже искать? Спасибо

Просто, как все гениальное. Спасибо автору

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _   _    __     _  _             _____  __   __
| | | | / /_ | || | _ __ | ___| \ \ / /
| | | | | '_ \ | || |_ | '_ \ | |_ \ V /
| |_| | | (_) | |__ _| | | | | | _| | |
\___/ \___/ |_| |_| |_| |_| |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.