Открыть текстовой файл, удалить строки по условию, сохранить как *.rtf

[Sammus]

Есть группа стандартных файлов субтитров *.srt.
Язык может быть любой. Кодировка UTF-8.
Задача.
Выбираем их в папке.
Поочередно открывает, удаляем:
- пустые строки,
- строки только из чисел,
- строки, содержащие " --> ",
Оставляем только строки с текстом.
Сохраняем как *.rtf

Пример файла:
1
00:00:00,480 --> 00:00:04,200
мчсмолчсмочсмлочлосмр

2
00:00:02,240 --> 00:00:05,799
мчсмолчсмочсмлочлосмр

3
00:00:04,200 --> 00:00:07,799
мчсмолчсмочсмлочлосмр

Заранее благодарю

[Sammus]

Проблема с цифрами. Что-то похожее с SRT видел. Но там пользовали Excel IsNumeric

[Дмитрий Щербаков(The_Prist)]

Заранее благодарю

эм...Ну очень странно выглядит "просьба"...
По сути Вы предлагаете, чтобы желающие помочь самостоятельно создали все примеры файлов .str, заполнили их, сохранили в нужной кодировке, потом написали с нуля код обработки и выложили? Ну честно - это прямо ТЗ, а не просьба помочь.
Почему сами ничего не попытались сделать? Насколько помню - VBA Вы не первый раз видите. Перебор файлов сделать не сложно. Остальное гуглится. Не очень понимаю такой лени, честно. Или Вы забыли что-то еще выложить(кусочек кода, например )

Проблема с цифрами. Что-то похожее с SRT видел. Но там пользовали Excel IsNumeric

в VBA тоже это есть. Поэтому все равно не понимаю сложностей.
Код не самый сложный - разве что с чтением UTF-8 у VBA есть небольшие проблемы. Но они решаемы:

Код Выделить Развернуть

Sub ConvertUTF8SrtToRTF()
    Dim x
    Dim objTxtFile As Object
    Dim sNewText$, sNewFN$, st$, lf&
    Dim oDoc As Document
    Dim IsAdd As Boolean
    'диалог выбора текстовых файлов. Подробнее:
    '   https://www.excel-vba.ru/chto-umeet-excel/dialogovoe-okno-vybora-fajlovpapki/
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Выбрать файлы srt"
        .Filters.Clear
        .Filters.Add "SRT files", "*.srt*", 1
        .FilterIndex = 1
        .InitialFileName = ActiveDocument.Path
        .InitialView = msoFileDialogViewDetails
        If .Show = 0 Then Exit Sub
        For lf = 1 To .SelectedItems.Count
            x = .SelectedItems(lf) '
            sNewFN = Replace(x, ".srt", ".") & "rtf"
            sNewText = Empty
            Set objTxtFile = CreateObject("ADODB.Stream")
            objTxtFile.Type = 2
            objTxtFile.Charset = "utf-8"
            objTxtFile.LineSeparator = -1
            objTxtFile.Open
            objTxtFile.LoadFromFile x
            objTxtFile.Position = 0
            Do Until objTxtFile.EOS
                st = objTxtFile.ReadText(-2)
                IsAdd = True
                If Len(st) = 0 Then
                    IsAdd = False
                End If
                If IsNumeric(st) Then
                    IsAdd = False
                End If
                If InStr(1, st, "-->", 1) > 0 Then
                    IsAdd = False
                End If
                If IsAdd Then
                    If Len(sNewText) Then
                        sNewText = sNewText & chr(13) & st
                    Else
                        sNewText = st
                    End If
                End If
            Loop
            'закрываем текстовый файл
            objTxtFile.Close
            'создаем новый файл rtf
            Set oDoc = Application.Documents.Add
            oDoc.Range.Text = sNewText
            oDoc.SaveAs2 sNewFN, wdFormatRTF
            oDoc.Close 0
        Next
    End With
    Set objTxtFile = Nothing
    MsgBox "Данные всех файлов обработаны", vbInformation, "www.excel-vba.ru"
End Subс плюшками вроде отключения обновления экрана и т.п. уже сами.
Код размещается в любом документе Word.

[Sammus]

Не очень понимаю такой лени, честно.

Дмитрий, ссори, не догадался. Вы абсолютно правы с критикой. Учту. За подмогу - низкий поклон. Погоняю чуть позже, сейчас запара. Здравия от души!

[Sammus]

Что-то не работает.
Пробежался по коду бегло. Метода - достойная. Буду потом разбирать - штудировать. Я еще новичок.
PS
Во вложении-исходники и желаемый результат.

[Дмитрий Щербаков(The_Prist)]

Что-то не работает.

логично. Это потому, что файлы сразу не выкладываете и помогающим надо все самим выдумывать.
У Вас разделитель на строки не vbCrLF, а vbLF. Это значит, что в этой строке:

Код Выделить Развернуть

objTxtFile.LineSeparator = -1надо "-1" заменить на 10. Тогда все заработает.

[Sammus]

Дмитрий, класс, заработало!
Про каретку надо изучить. Не знал.
Нашел Ваш совет на эту тему:
"Есть нюансы. Не всегда применяются именно эти разделители. Могут быть и vbCrLf(в Excel он чаще применяется) и оба отдельно. Плюс есть еще и вордовский Crh(13). В общем нет универсального - все зависит от данных. Можете свою функцию написать, которая все возможные(известные Вам) переносы будет заменять символом Chr(10). Это будет надежно и после сможете и Split использовать и все остальное."
Спасибо и здравия от души!