Как в большом текстовом файле записанного одной очень длинной строкой с кодировкой utf-8 найти и заменить текст?

'==================================================================================================
Function TxtFind(sPath$, s1$, s2$, sEnd$, sOut$) As Boolean
Dim s$, i1&, i2&
 
s = PRDX_TextFile_GetString(sPath)
s = PRDX_CodePage_CodePageToWin(s)
 
i1 = InStr(1, s, s1, vbTextCompare):                If (i1 = 0) Then Exit Function
i1 = InStr(i1 + Len(s1), s, s2, vbTextCompare):     If (i1 = 0) Then Exit Function
i1 = i1 + Len(s2)
i2 = InStr(i1, s, sEnd, vbTextCompare):   If (i2 = 0) Then Exit Function
 
sOut = Mid$(s, i1, i2 - i1): TxtFind = True
End Function
'--------------------------------------------------------------------------------------------------
Private Sub Test_TxtFind()
Dim s$, s1$, s2$, sEnd$
 
s = "…\ШаблонТранспортнойНакладной_002.fp3"
If TxtFind(s, "memo91", " text=""", """", s) Then MsgBox "«" & s & "»"
End Sub
'==================================================================================================

Sub Replace_In_UTF8_TextFile_ByCells()
Dim sFindVal As String, sReplaceVal As String, lPos As Long, iCount As Integer, iTempCount As Integer
Dim objWorksheet As Worksheet
Dim objADOStream As Object
Dim sSRCTextFilePath As String, sDSTFilePath As String
Dim sVal As String, lVal As Long, lRows As Long
'Имя исходного файла в папке где исполняем
    Const aSRCFileName As String = "ШаблонТранспортнойНакладной_001.fp3"
'Имя результирующего файла в папке где исполняем
    Const aResFileName As String = "ШаблонТранспортнойНакладной_Res001.fp3"
'--------------------------------------------------------------------------------------------------------
 
'Полный путь к исходному файлу
    sSRCTextFilePath = ThisWorkbook.Path & "\" & aSRCFileName
    If Dir(sSRCTextFilePath) = "" Then
        MsgBox "Файл: " & aSRCFileName & _
            " - не найден в папке приложения!", vbExclamation
        Exit Sub
    End If
    
'Путь к файлу назначения:
    sDSTFilePath = ThisWorkbook.Path & Application.PathSeparator & aResFileName
    
    Set objWorksheet = ThisWorkbook.Worksheets(1)
 
'Номер посл. заполненной строки
    lRows = objWorksheet.UsedRange.Rows.Count
    If Not lRows > 0 Then
        MsgBox "Данные для замены не найдены!", vbExclamation
        Exit Sub
    End If
    
'Чтение файла
    Set objADOStream = CreateObject("ADODB.Stream")
    objADOStream.Charset = "utf-8"
    objADOStream.Open
    objADOStream.LoadFromFile sSRCTextFilePath
    sVal = objADOStream.ReadText()
    objADOStream.Close
 
' Поиск и замена
    With objWorksheet
        For lVal = 1 To lRows
            sFindVal = .Cells(lVal, 1) & ""     ' Что меняем
            sReplaceVal = .Cells(lVal, 2) & ""  ' На что меняем
            
            If Len(sFindVal) > 0 And Len(sReplaceVal) > 0 Then
                lPos = InStr(1, sVal, sFindVal, vbTextCompare)
                If lPos > 0 Then
                    sVal = Replace(sVal, sFindVal, sReplaceVal, 1, 1, vbTextCompare)
                    ' Проверка:
                    lPos = InStr(1, sVal, sFindVal, vbTextCompare)
                    If lPos = 0 Then
                        iCount = iCount + 1
                    Else
                        MsgBox "Выражение: " & sFindVal & " в файле не найдено!", vbExclamation
                        Debug.Print sFindVal & " -> " & sReplaceVal
                    End If
                End If
            End If
        Next
    End With
    
'Save & Close
    objADOStream.Open
    objADOStream.WriteText sVal
    objADOStream.SaveToFile sDSTFilePath, 2   ' Сохранение (2 = Create Or Update)
    
    objADOStream.Close: Set objADOStream = Nothing
    Set objWorksheet = Nothing
 
    sVal = "В исходном файле произведено замен: " & iCount & vbCrLf & _
        "Изменённый файл сохранён как:" & vbCrLf & sDSTFilePath
 
    'Debug.Print sVal
    MsgBox sVal, vbInformation
End Sub