VBA zu lesen Eingabe aus einer Datei

Question

Ich versuche, den folgenden Code zu ändern, wird es die Word-Dokumente in Ordnung verschmelzen, aber ich habe Textdatei mit jeder Zeile „* Namen * .docx“ „* Name2 * .docx zu sein“ usw. Ich möchte, dass der VBA-Makro die Textdatei zeilenweise liest und alle Dokumente zusammenführt, die dem Muster entsprechen. Nach Fertigstellung sollten 27 Dokumente vorhanden sein und jeweils mit dem Titel "* Name" gesichert werden damit ich wissen kann welches was ist. Jede Hilfe wäre sehr

geschätzt werden

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

Ich denke, es ist nur eine Frage der Zugabe einer zusätzlichen Schleife, die die Eingabedatei Zeile für Zeile liest und verwendet dann Ihre Schleife oben.

In diesem Beispiel wird das Skriptdateisystemobjekt verwendet, um die Datei zu öffnen und zu lesen.

Ich nehme an, was Sie oben gesagt haben, ist was Sie eigentlich meinen - und die Dateispezifikation ist in der Textdatei. Ändern Sie die Konstanten auf Ihre Bedürfnisse

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