VBA私は、次のコードを変更しようとしていたファイル

Question

から入力を読み込むために、それは細かいWord文書をマージしますが、私はすべての行が「*名前*の.docx」「* Name2は*の.docx」でのテキストファイルを持っていますVBAマクロは、行ごとにテキストファイルを読み込み、パターンに一致するすべてのドキュメントをマージし、完了したら27個のドキュメントにし、それぞれを「*名前」タグを含むタイトルで保存することが望ましい私はどちらがどちらであるかを知ることができます。すべてのヘルプは大幅に

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

をいただければ幸い私はそれはラインで入力ファイルの行を読み込み、上記のあなたのループを使用して、余分なループを追加するだけの問題だと思います。

この例では、スクリプトファイルシステムオブジェクトを使用してファイルを開いて読み取ります。

上記の内容は、実際には何を意味しているのでしょうか？ファイル仕様はテキストファイルにあります。あなたのニーズに合わせて定数を変更してください

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