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

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