MS Word...Finding Text

[jesus4u]

How can I extract content from a Word document that follows this pattern? The content is not always the same. I just want to content beneath the titles.

Title (33:45)
This is some content that I want to extract.

Second Title (34:00)
More content here that I want to get...

[Matt_T_hat]

Originally posted by jesus4u
How can I extract content from a Word document that follows this pattern? The content is not always the same.

Is this a word document that you will create or something you are sent every so often? What package will you be useing and have you considered bookmarks... These are the questions that will be asked I am sure.

With this new information in mind there maybe a way...

[adocwra]

also does the word document have stiles applied to it
like heading 1 Normal
etc.

[jesus4u]

Originally posted by Matt_T_hat
Is this a word document that you will create or something you are sent every so often? What package will you be useing and have you considered bookmarks... These are the questions that will be asked I am sure.

With this new information in mind there maybe a way...

Yeah well there are already 800+ docs that are this way! There really aren't any consistencies like Heading 1 etc... The ONLY thing I can tell you is that all sections are subdivided with BOLD headers. There aren't any bookmarks in the docs at all.

sorry for not much more info than that.

[adocwra]

WELL IN WORD YOU COULD HAVE A MACRO fo thru and place a bookmark on the headers by searching and finding the ( and ) and the : where the font is bold

kinda
loop
editfind
insertbookmark "b" & i

and then loop and find b1 to b2 and select the text


i am looking at vba on how to do that

[jesus4u]

yes I already am using VBA MAcros but I can't seem to figure out how to insert the bookmarks at the right place.

[adocwra]

i tried this in word and it kinda works but i'm sure there are people out there that can make this work properly
I have to go

hope this helps
remember this works in word and only just
it was just to get you going

Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .Font.Bold = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
   Selection.Find.Execute
    i = 1
    While Selection.Find.Found = True
   
        a = Selection.Text
        Debug.Print a
    
        If InStr(1, a, "(") > 0 And InStr(1, a, ":") > 0 And InStr(1, a, ")") > 0 Then
            Selection.Bookmarks.Add "b" & i
            Debug.Print "b" & i
            i = i + 1
        End If
        Selection.Find.Execute
     Wend
     Dim nRange As Word.Range
        Debug.Print ActiveDocument.Bookmarks.Count
        If ActiveDocument.Bookmarks.Count >= 1 Then
            For x = 1 To i - 1
                Debug.Print "b" & Trim(Str(x))
                Set nRange = ActiveDocument.Range( _
                ActiveDocument.Bookmarks("b" & Trim(Str(x))) _
                .Range.Start, _
                ActiveDocument.Bookmarks("b" & Trim(Str(x + 1))).Range.End)
                MsgBox nRange.Text
            Next x
        
        End If

[jesus4u]

Very much thanks for the code. It works pretty well. I will look in more detail. I get an error towards the end of the run. Look at the picture.

It highlights this part of the code..

                Set nRange = ActiveDocument.Range( _
                ActiveDocument.Bookmarks("b" & Trim(Str(x))) _
                .Range.Start, _
                ActiveDocument.Bookmarks("b" & Trim(Str(x + 1))).Range.End)

[jesus4u]

here

[adocwra]

yes it means one book mark didnt get created that is because it starts over again before the loop ends I will look into changing the loop to end before it creates the boolmark

[jesus4u]

How can I set a bookmark at the very end of the ActiveDocument? It is skipping the last area of content I want to extract.

thanks

[adocwra]

put this as first line
Selection.HomeKey Unit:=wdStory

then tis moves to end of documemt


Selection.EndKey Unit:=wdStory

i would insert a title
"(end of document"

end of document and let it be bookmarked then check to see if selection ="(end of document"

[adocwra]

the smiley should have been a ( and a :

[jesus4u]

you mean place

Selection.HomeKey Unit:=wdStory

here?

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
etc...

[jesus4u]

Got it! This seems to be ok for now. I REALLY appreciate your help.

    On Error Resume Next
    Dim TextWriter As FileSystemObject
    Set TextWriter = New FileSystemObject
    Dim writer As TextStream
    TextWriter.CreateTextFile "c:\Results.txt", True
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .TEXT = ""
        .Replacement.TEXT = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .Font.Bold = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
    i = 1
    While Selection.Find.Found = True
        a = Selection.TEXT
        Debug.Print a
        If InStr(1, LCase(a), "slate") > 0 Then
            Selection.Bookmarks.Add "b" & i
            Debug.Print "b" & i
            i = i + 1
        ElseIf InStr(1, a, "(") > 0 And InStr(1, a, ":") > 0 And InStr(1, a, ")") > 0 Then
            Selection.Bookmarks.Add "b" & i
            Debug.Print "b" & i
            i = i + 1
        End If
        Selection.Find.Execute
     Wend
     Selection.EndKey Unit:=wdStory
     Selection.Bookmarks.Add "b" & i
                   
     Dim nRange As Word.Range
        Debug.Print ActiveDocument.Bookmarks.Count
        If ActiveDocument.Bookmarks.Count >= 1 Then
            For x = 1 To i - 1
                'Debug.Print "b" & Trim(Str(x))
                Set nRange = ActiveDocument.Range( _
                ActiveDocument.Bookmarks("b" & Trim(Str(x))) _
                .Range.Start, _
                ActiveDocument.Bookmarks("b" & Trim(Str(x + 1))).Range.Start)
                'Out of range error
                If err.Number = 4608 Then
                    Set TextWriter = Nothing
                    Exit Sub
                End If
                Set writer = TextWriter.OpenTextFile("c:\Results.txt", 8)
                writer.WriteLine nRange.TEXT & vbCrLf & vbCrLf
                writer.Close
                Set writer = Nothing
            Next x
        
        End If
        Set TextWriter = Nothing