Macro to copy select row from text files into word documents (one to one basis)

485 Lec1A.srt485 Lec1B.srt485 Lec2B.srt485 Lec5 09 17 2020.srt485 Lec2A.srtDear experts,

The above excel macro was provided by a Certified expert by name Als315 (acknowledging and giving due credit to the timely help and support.

Speaking about myself, I am not a coder and I cannot code.

The below code does the following:

1. There is a folder and the folder has a single text file. The folder also has a word document with this macro fed into it.
2. The text file is in a particular form and it is standard throughout the length of the file
3. The idea of the macro is to source all rows multiple of 4 and copy into a word document.
4. When the macro is run, it opens the text file and copies every text/string (multiple of 4) and paste it into a word document, one text string after the other separated by ‘//’.
5. End with a message of summary
6. The macro copies data into the same document where the macro is loaded

Now I want to save more than one text file. All the text files will have the same standard form for which the below macro will do the required on a standalone basis.

I will be happy if the above macro can be amended to incorporate the following features

1. Open a text file at a time to apply the below macro.
2. Open a new document and copy the name text file in the very first row and then leave two rows blank.
3. Copy the data from text file using the above macro into the new word document
4. Do not save the word document, the user can save it myself. Also this will not complicate the macro proess.
5. Close the current text file without saving
6. Then repeat the same exercise for the remaining text files in the folder
7. End the macro when the macro has finished working on all the text files in the folder.
8. The word document on which macro is run will be holding only the macro and not any other information from the text files.

Option Explicit

Sub import_files()

Dim path As String, File As String

Dim Str As String

Dim R As Long, I As Long

Dim fso As Object

Set fso = CreateObject("Scripting.FileSystemObject")

Dim ts As Object

path = "C:\Users\KOTAD\Desktop\Test macro" 'Correct path to your file

File = Dir(path & "\*.srt")

If File = "" Then

    MsgBox "File not found", vbOKOnly

    Exit Sub

Else

    I = 1

    Set ts = fso.OpenTextFile(path & "\" & File)

    Str = ""

    Do While Not ts.AtEndOfStream

        Str = ts.ReadLine

       If I Mod 4 = 0 Then

             Selection.TypeText Text:="//" & Str '& vbCrLf

        End If

        I = I + 1

    Loop

    ts.Close

End If

    MsgBox "Import finished, file: " & File & " lines: " & I, vbOKOnly

End Sub