Блог

У меня есть документ с несколькими строками темы — я думаю, кто-то скопировал и вставил 100 электронных писем в один документ Word. Я хочу захватить все строки темы и вставить их в новый документ для дальнейшего изменения.

Я использовал сочетание кода, которое я нашел здесь, чтобы приблизиться. Пока я могу захватить первую итерацию темы и вставить ее в новый документ, но у меня возникают проблемы с пониманием того, как выполнить цикл, чтобы он продолжал работать по документу, то есть для захвата других «99» экземпляров тем. Это то, что я пытался

 Sub SubjectFind()

Application.ScreenUpdating = False

Application.Browser.Target = wdBrowseSeciton

    For I = 1 To ActiveDocument.Sections.Count
    Dim rng1 As Range
    Dim rng2 As Range
    Dim strTheText As String
    Dim DestFileNum As Long
    Dim sDestFile As String

    sDestFile = “C:UserspascualtDocumentsDoc1.txt” ‘Location of External File
    DestFileNum = FreeFile()

    Open sDestFile For Output As DestFileNum ‘This opens new file with name DestFileNum
    Set rng1 = ActiveDocument.Range
    If rng1.Fine.Execute(Findtext:=”Subject:”) Then
        Set rng2 = ActiveDocument.Range(rng1.End, ActiveDocument.Range.End)
        If rng2.Fine.Execute(Findtext:=”Ref:”) Then
            strTheText = ActiveDocument.Range (rng1.End, rng2.Start).Text
            Print #DestFileNum, strTheText ‘Print # will write to external file
        End If
    End If
    Application.Browser.Next
        Next I
    Close #DestFileNum
End Sub
 

Попробуйте, например:

 Sub Demo()
Application.ScreenUpdating = False
Dim StrOut As String, wdDoc As Document
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "Subject:*^13"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    StrOut = StrOut amp; .Text
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Set wdDoc = Documents.Add
wdDoc.Range.Text = StrOut
Application.ScreenUpdating = True
End Sub