Problem Searching Range Object

[malamin]

At the outset let me say that I'm trying to do this project after
familiarizing myself with the word object model. In a nutshell, I'm opening
a document, storing text in a variable and opening another document to
search for that same text. My problem is my search fails even though I can
verify the existence of the search text in the document. Example:
In document usecase I'm storing the following text in a variable.
UCR332.2 SA or PA has entitlement to run this report.

In document Trace I see the following value but my search fails.
UCR332.2: SA or PA has entitlement to run this report.



In the first document I realize that I don't have a colon but I'm adding the
colon into the string before performing my search. When I loop through the
document to perform my search, sometimes it finds the results, sometimes it
doesn't. The most frustrating part is it's not failing every time. Here's
my code. I'd greatly appreciate if anyone could point out any logical
errors I may be making.



Thanks





Sub Combine()
Dim docTraceTree As Document, docUseCase As Document
Dim para As Paragraph
Dim rngUseCase As Range, rngTraceTree As Range
Dim intBkmCount As Integer
Dim bkm As Bookmark
Dim strCaseBookMark As String
Dim J As Integer
Dim strMyPara As String
Dim strMyTrace As String
Set docTraceTree = Documents.Open(FileName:="C:\Documents and
Settings\A021871\Desktop\TraceTree.doc", Visible:=True)
Set docUseCase = Documents.Open(FileName:="C:\Documents and
Settings\A021871\Desktop\UseCase.doc", Visible:=True)
Dim strLeftOfColon As String
Dim strRightOfColon As String
Dim intLength As Integer
Dim intColonLocation As Integer, intPeriodLocation As Integer
Dim strSearch As String, strTemp As String
Set rngTraceTree = docTraceTree.Content

docUseCase.SaveAs "C:\Malik.doc"
Call CheckSpaces

For J = 1 To docUseCase.Bookmarks.Count
Set bkm = docUseCase.Bookmarks(J)
Set rngUseCase = docUseCase.Bookmarks(J).Range

strMyPara = Trim(rngUseCase.Text)

intLength = Len(strMyPara)

strLeftOfColon = Left(strMyPara, (InStr(1, strMyPara, " ") - 1)) & ":"

intColonLocation = InStr(1, strMyPara, " ") - 1
strRightOfColon = (Mid(strMyPara, intColonLocation + 1))
strRightOfColon = RTrim(strRightOfColon)
strSearch = strLeftOfColon & strRightOfColon
strSearch = Trim(strSearch)
intPeriodLocation = InStr(intColonLocation + 1, strSearch, ".")
If intPeriodLocation > 0 Then
strTemp = Left(strSearch, intPeriodLocation)
strSearch = strTemp
End If
'strSearch = strTemp

rngTraceTree.Find.Text = strSearch
'rngTraceTree.Find.MatchAllWordForms = False
rngTraceTree.Find.MatchCase = False
rngTraceTree.Find.MatchWildcards = True
rngTraceTree.Find.Execute

If rngTraceTree.Find.Found Then


Do
Set rngTraceTree = rngTraceTree.Next(wdParagraph, 1)
If Not rngTraceTree.Text Like "UCR*" Then
With rngUseCase
.Collapse Direction:=wdCollapseEnd
.InsertParagraphAfter
.Text = vbCrLf & rngTraceTree.Text
.ParagraphFormat.Alignment = wdAlignParagraphLeft
.Font.Bold = True
.Font.Color = wdColorBlue
End With
End If

Loop Until rngTraceTree.Text Like "UCR*"
End If

Next
docTraceTree.Close
docUseCase.Close
Set rngUseCase = Nothing
Set rngTraceTree = Nothing
Set bkm = Nothing
Set docTraceTree = Nothing
Set docUseCase = Nothing

End Sub
Sub CheckSpaces()
Call MakeChanges(".")
Call MakeChanges("!")
Call MakeChanges(":")
Call MakeChanges(Chr$(34))
End Sub

Sub MakeChanges(PuncMark As String)
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
'Selection.Find.Style = ActiveDocument.Styles(StyName)
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = PuncMark & " "
.Replacement.Text = PuncMark & ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Text = PuncMark & " "
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

 

[Jezebel]

You should have gone with your idea of hiring someone to do this. Being the
holiday season, maybe you'll find someone prepared to spend the time
trawling through your code; but it's a big ask. The thing is, there are two
types of bug in code like yours. Little bugs like one-line mistakes, and big
ones like the entire approach is ill-conceived. The code you post suffers
badly from the second.

I've read several of your explanations of what you're trying to do, creating
a new document from the merge of two others, and I still don't really
understand it (and I do this sort of thing for a living). Believe me, if you
can't explain it, you sure as hell can't write the code for it.

You're obviously putting in a lot of effort on this, so it would be a pity
if your time were wasted. But as it is, my courage fails. Go out and govern
New South Wales.

 

[malamin]

Thanks for taking the time to respond to my post even though your response
wasn't too encouraging. I agree with you whole heartedly. I "should" have
hired someone to do this but management wouldn't allow me. Unfortunately
this is not a project that I feel qualified to do. Again, management doesn't
agree. As a result, I've tried to cram in everything I know about the Word
Object model and give it my best shot. The difficult thing is I don't know
the ins and outs of Word VBA so I was hoping that this group would help. On
a daily basis I work in Sequel Server and Access. You hinted that I don't
know what I'm doing. You're correct, I don't know what I'm doing. But I
didn't have any other choice. Be that as it may, the whole thing has been a
learning experience for me and I honestly thank you for the numerous replys
that you posted to my questions. Good day all. Enjoy the holidays.

 

[Helmut Weber]

Hi Malamin,
if you have to rely on answers in the newsgroups,
break down your project into smaller pieces,
use filenames like
c:\test\output.doc
c:\test\input-1.doc, c:\test\input-2.doc
so that everybody willing to help can use
at least parts of your code without much alterations.
Some examples:
1 Use range instead of selection e.g. in "MakeChanges".
2 Selection.Find
.Text = PuncMark & " "
seems to be questionable as, I think, you might be searching
for a punctuation mark followed by any number of spaces,
not just exactly 3 spaces.
3 .Replacement.Text = PuncMark & ""
is useless, replacement.text = PuncMark would be enough.
4. Selection.Find.Text = PuncMark & " "
is repeating the search defined at the beginning of the macro. Why?
5. Have a close look at:

UCR332.2 SA or PA has entitlement to run this report.
UCR332.2: SA or PA has entitlement to run this report.

There are 2 leading spaces in the first of these two lines.
Though I think you use "trim" on it, it might be a clue.
6. rngTraceTree.Find.MatchWildcards = True
I can't see any wildcards in the search string, though I might be wrong.
7. rngTraceTree.Find.Execute
If rngTraceTree.Find.Found Then
Do
Loop
...
makes you code hard to read
While .execute
' do something
Wend
would be enough

and so on and on and on.

I'd suggest, use 1 single document at first and make sure,
that search and replace is working under all circumstances.

If you send me a doc, I'll have a look at it.

Good luck
Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000

 

[malamin]

How do I send it to you? Do you want me to use email or the forum?

Thanks

 

[Helmut Weber]

Hi Malamin,
by email to "red.sys" & chr(64) & "t-online.de",
plus the code...
and another advice,
stick to always the same name in the groups.

Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000

 

[malamin]

Good advice,

I have two profiles, one at work and one at home. That's why i had the two
names. I'll change them to reflect only one.

Thanks

 

[Helmut Weber]

Hi Malik,
how about this one, according to exactly the 2 docs you sent me!
With other documents there may be other limiting conditions.
And this could be a lot shorter, but then it would be more
difficult to understand.

Sub Test555()
Dim iMtc As Integer ' matches found
Dim iBkm As Integer ' number of bookmarks
Dim sTmp As String ' temporary string
Dim rBkm As Bookmark ' bookmark
Dim dRsl As Document ' document result = usecase
Dim dCmp As Document ' document compare = tracetree
Dim rRsl As Range ' range of doc result
Dim rCmp As Range ' range of doc compare
Set dRsl = Documents("result.doc") ' doc usecase
Set dCmp = Documents("compar.doc") ' doc tracetree
Set rRsl = dRsl.Range ' range of doc result
Set rCmp = dCmp.Range ' range of doc compare

dCmp.Activate ' for testing
ResetSearch
iBkm = rRsl.Bookmarks.Count
For Each rBkm In dRsl.Bookmarks ' all bookmarks
sTmp = rBkm.Range.Text
' remove text until tab
sTmp = Right(sTmp, Len(sTmp) - InStr(sTmp, Chr(9)))
' remove text form first space onwards
sTmp = Left(sTmp, InStr(sTmp, Chr(32)) - 1)
sTmp = sTmp & ":" ' add colon
' MsgBox "[" & sTmp & "]" for testing
With rCmp.Find
.Text = sTmp
If .Execute Then
iMtc = iMtc + 1
rCmp.Select ' for testing
Set rCmp = dCmp.Range ' reset the range !!!
' MsgBox "Found: " & sTmp ' for testing
End If
End With
Next
If iBkm = iMtc Then
MsgBox "wow, gotcha"
Else
MsgBox "something s wrong"
End If
End Sub

Public Sub ResetSearch()
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
End Sub

Greetings from Bavaria, Germany
Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/