VBA to read input from a file - vba

Question

I am trying to modify the following code, it will merge the Word Documents fine, but I have text file with every line being "*Name*.docx" "*Name2*.docx", etc, I would like the VBA macro to read the text file line by line and merge all the documents that match the pattern, should be 27 documents when done and save each one preferably with the a title that includes the "*Name" tag so I can know which is which. Any help would be greatly appreciated
Sub MergeDocs()
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String
Const strFolder = "C:\test\"
Set MainDoc = Documents.Add
strFile = Dir$(strFolder & "*Name*.docx")
Do Until strFile = ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertFile strFolder & strFile
strFile = Dir$()
Loop
MsgBox ("Files are merged")
End Sub

Answer 1

I think it's just a matter of adding an extra loop that reads the input file line by line and then uses your loop above.
This example uses the scripting filesystemobject to open the file and read it.
I assume what you've said above is what you actually mean - and the file spec is in the text file. Change the constants to fit your needs
Sub MergeDocs()
Const FOLDER_START As String = "C:\test\" ' Location of inout word files and text file
Const FOLDER_OUTPUT As String = "C:\test\output\" ' send resulting word files here
Const TEST_FILE As String = "doc-list.txt"
Dim rng As Range
Dim MainDoc As Document
Dim strFile As String
Dim strFileSpec As String
Dim strWordFile As String
Dim objFSO As Object ' FileSystemObject
Dim objTS As Object ' TextStream
Set objFSO = CreateObject("Scripting.FileSystemObject")
strFile = FOLDER_START & TEST_FILE
If Not objFSO.FileExists(strFile) Then
MsgBox "File Doesn't Exist: " & strFile
Exit Sub
End If
Set objTS = objFSO.OpenTextFile(strFile, 1, False) 'The one was ForReading but for me it threw an error
While Not objTS.AtEndOfStream
Set MainDoc = Documents.Add
' Read file spec from each line in file
strFileSpec = objTS.ReadLine ' get file seacrh spec from input file
'strFileSpec = "*NAME2*"
strFile = Dir$(FOLDER_START & strFileSpec & ".docx") ' changed strFolder to FOLDER_START
Do Until strFile = ""
Set rng = MainDoc.Range
rng.Collapse wdCollapseEnd
rng.InsertFile FOLDER_START & strFile ' changed strFolder again
strFile = Dir$() ' Get next file in search
Loop
strWordFile = Replace(strFileSpec, "*", "") ' Remove wildcards for saving filename
strWordFile = FOLDER_OUTPUT & strWordFile & ".docx"
MainDoc.SaveAs2 strWordFile
MainDoc.Close False
Set MainDoc = Nothing
Wend
objTS.Close
Set objTS = Nothing
Set objFSO = Nothing
MsgBox "Files are merged"
End Sub