VBA從文件中讀取輸入

Question

我想修改下面的代碼，它會合並Word文檔很好，但我有每一行是「*名稱*的.docx」「*名2 *的.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") 

末次

Answer 1

我認爲它只是增加一個額外的循環，逐行讀取輸入文件行的問題，然後使用上面的循環。

本示例使用腳本filesystemobject打開文件並讀取它。

我假定你上面所說的是你實際上的意思 - 文件規格在文本文件中。更改常量以適應您的需求

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