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