excel - VBA를 사용하여 단어 파일에서 장 제목 찾기 및 개별 단락을 새 단어 파일로 복사

이전에 게시 한 문제 (링크는 아래에 있음)로 아무도 나를 도울 수 없었기 때문에 이제 VBA를 통해 작업을 해결하려고합니다.

찾기 단어 파일의 제목과 그 이후의 전체 단락을 파이썬으로 새 단어 파일로 복사

간단히 요약하면, 많은 양의 워드 파일이 있으며, 각각 더 읽기 쉬운 크기로 줄이려고합니다. 각 파일에는 항상 '제목 2'로 서식이 지정된 제목이 여러 번 나타납니다. 문서에서 여러 번 발생하는이 특정 제목을 찾고 해당 장과 함께이 장의 모든 텍스트 부분을 새 단어 문서로 복사하려고합니다.

복사하려는 챕터의 파일과 각 제목을 나열하는 Excel 파일을 만들기로 결정했습니다 (아래 그림 참조).

이 작업을하기 위해 다음 코드를 작성했습니다 :

Sub SelectData()
    Application.ScreenUpdating = False
    Dim WdApp As Word.Application
    Set WdApp = CreateObject("Word.Application")
    Dim Doc As Word.Document
    Dim NewDoc As Word.Document
    Dim HeadingToFind As String
    Dim ChapterToFind As String
    Dim StartRange As Long
    Dim EndRange As Long
    Dim WkSht As Worksheet
    Dim LRow As Long
    Dim i As Long
    Set WkSht = ThisWorkbook.Sheets("Sheet1")
    LRow = WkSht.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row
    With WkSht
        For i = 1 To LRow
            If Dir(.Cells(i, 1).Text, vbNormal) = "" Then
                .Cells(i, 3).Value = "Please check File Location"
            Else
                Set Doc = WdApp.Documents.Open(Filename:=.Cells(i, 1).Text, _
                AddToRecentFiles:=False, Visible:=False, ReadOnly:=False)
                Set NewDoc = Documents.Add
                ChapterToFind = LCase(.Cells(i, 2).Text)
                    With Doc
                    Selection.HomeKey Unit:=wdStory
                        With Selection
                            With .Find
                                .ClearFormatting
                                .Text = ChapterToFind
                                .MatchWildcards = False
                                .MatchCase = True
                                .Execute
                            End With
                            If .Find.Found Then
                                .Collapse wdCollapseStart
                                With .Find
                                    .Text = ""
                                    .Style = "Heading 2"
                                    .Forward = False
                                    .Execute
                                End With
                                .MoveDown Count:=1
                                .HomeKey Unit:=wdLine
                                StartRange = .Start

                                .Find.Forward = True
                                .Find.Execute
                                .Collapse wdCollapseStart
                                .MoveUp Count:=1
                                .EndKey Unit:=wdLine
                                EndRange = .End
                                Doc.Range(StartRange, EndRange).Copy
                                NewDoc.Content.Paste
                                NewDoc.SaveAs2 Doc.Path & "Clean" & ".docx", wdFormatFlatXML
                            Else
                                WkSht.Cells(i, 4).Value = "Error Chapter Not Found"
                            End If
                        End With
                End With
                WdApp.Quit
                Set Doc = Nothing: Set NewDoc = Nothing: Set WdApp = Nothing: Set WkSht = Nothing
                Application.ScreenUpdating = True
            End If
        Next
    End With
End Sub

그러나 나는 정말로 고투하고있다. 명령 (RunTimeError 438)에 계속 오류가 발생하여 작동하지 않는 것 같습니다 :

Selection.HomeKey Unit:=wdStory

단어 명령을 얻으려면 참조에서 Microsoft Word 15.0 Object Library를 활성화해야한다는 것을 알고 있습니다. 그럼에도 불구하고 작동하지 않습니다.

도움을 주시면 감사하겠습니다. 물론 다른 제안도 가능합니다.

단어 파일은 아래 그림과 비슷하지만 추출하려는 장이 한 워드 문서 내에서 여러 번 발생할 수 있습니다. 결과적으로 내 코드에는 루프 또는 무언가가 필요할 수 있으므로이 작업을 수행 할 수 없었습니다.

또한이 주제에 대한 다음 링크를 고려했습니다.

Powerpoint와 함께 VBA를 사용하여 Word Doc에서 제목을 검색하고 다른 Word 문서로 텍스트 복사

VBA : Excel에서 열린 단어

단어 vba : 제목 사이의 텍스트 선택