Printable View
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...
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.Quote:
Originally posted by jesus4u
How can I extract content from a Word document that follows this pattern? The content is not always the same.
With this new information in mind there maybe a way...
also does the word document have stiles applied to it
like heading 1 Normal
etc.
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.Quote:
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...
sorry for not much more info than that.
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
yes I already am using VBA MAcros but I can't seem to figure out how to insert the bookmarks at the right place.
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
Code: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
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..
Code:Set nRange = ActiveDocument.Range( _
ActiveDocument.Bookmarks("b" & Trim(Str(x))) _
.Range.Start, _
ActiveDocument.Bookmarks("b" & Trim(Str(x + 1))).Range.End)
here
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
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
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:)"
the smiley should have been a ( and a :
you mean place
here?Code:Selection.HomeKey Unit:=wdStory
Code:Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
etc...
Got it! This seems to be ok for now. I REALLY appreciate your help.
Code: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