2016-07-28 4 views
1

Я пытаюсь изменить следующий код, он будет объединять документы Word, хорошо, но у меня есть текстовый файл с каждой строкой быть «* Имени * .docx» «* Name2 * .docx» , и т. д., я бы хотел, чтобы макрос VBA читал текстовый файл по строкам и объединять все документы, соответствующие шаблону, должен быть 27 документов, когда это делается, и сохранять каждый из них предпочтительно с заголовком, который содержит тег «* Name» поэтому я могу знать, что есть. Любая помощь будет принята с благодарностьюVBA для чтения данных из файла

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

ответ

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 
+0

Спасибо за помощь. Тестирование этого сейчас. Обновит результаты. – Nolemonkey

+0

ОК, я, должно быть, сделал что-то неправильно, когда впервые редактировал его, но теперь он почти полностью работает. Для некоторых моих документов он полностью сглаживает контент, а для некоторых я просто получаю пустые документы. Не уверен, что происходит, но я пытаюсь посмотреть на это сейчас. Соглашение об именах существует, пытаясь понять, почему какой-то контент слит, а другие пустые. – Nolemonkey

+0

Nice pickup - Спасибо за редактирование! – dbmitch

Смежные вопросы