Question

我正在尝试修改以下代码，它会合并Word文档，但我的文本文件中的每一行都是＆＃34; *名称*。docx＆＃34; ＆＃34; * Name2 *。docx＆＃34;等等，我希望VBA宏逐行读取文本文件并合并所有匹配模式的文档，应该是27完成后的文档并保存每个文档，最好使用包含＆＃34; *名称＆＃34;的标题。标签所以我可以知道哪个是哪个。任何帮助将不胜感激

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

VBA从文件

1 个答案: