Printable View
Hello,
I need help with a Word macro.
I would like to search a document for a string. If the string is found I want to copy the sentence containing the string to an Excel document.
I have a little experience with Excel and Access VBA but none with the objects and methods used with Word. I would be grateful if someone could at least get me started.
I am using Word 2000.
Thanks.
Hi Ron!
I read your question 2 or 3 days ago, and I thought "wow, that sounds simple, I'll go back and answer that when I have time, but I bet someone else will surely answer any minute now before I get a chance."
well...
maybe it wasn't so simple, and maybe that's why no one has jumped on it yet. I began fooling around with this this morning, and between going out to lunch and running a few errands, this problem has taken me just about all day!! I can't believe it.
It sounds like you actually want to learn about Word macros, Ron, rather than just copy and paste them. So I would suggest that if you wish to understand the macro I have written, please read the entire thread regarding Johnske's question, Cleaning up a Word document.
The key here is the use of "wildcards." Before I wrote this macro for you, I studied the site that mdmackillop suggested in the thread about Johnske's question. (the suggested site is: Finding and Replacing Characters Using Wildcards, on the Word MVPs site)
So...
what this macro does is loop through all sentences in a document. It will identify a "sentence" as anything that begins either at the beginning of a paragraph or at the end of a prior sentence (meaning that it follows a . or a ? or a !) and that subsequently ends at the very next . or ? or ! without any intervening hard returns.
As the macro identifies each sentence, it then does a "mini search" within the sentence to find your desired word. If the desired word is found, then the sentence is saved in memory.
Once all sentences have been searched, then we can tell the macro (in the future) to do whatever we want with the "good" sentences.
Right NOW, in this current macro, a new document is created and a TABLE is inserted with each sentence in a single cell of the TABLE. So, you may then manually copy the table and paste it into an Excel spreadsheet. That part can also later be automated within the macro.
Also, I found out that my macro fails (in a very aggravating way!!!) if the document contains fields or hyperlinks. It may also fail if the document has other "strange stuff" in it, but I have definitely confirmed that it does not like fields or hyperlinks.
BUT!! DON'T WORRY IF YOUR DOCUMENT HAS THAT STUFF. I incorporated a "workaround" into my macro. Before searching, the macro actually copies the entire document and does a "text only" paste operation into a HIDDEN document (that can't be seen on screen but that is running in the backgroun). So the macro will safely be fed ONLY TEXT from the hidden doc.
Here it is:
[vba]Sub CopyCertainSentences()
Dim myOriginalDoc As Document
Dim myHiddenDoc As Document
Dim OldValue As Long
Dim ArrayOfSentences() As String
Dim TargetWord As String
TargetWord = Trim(InputBox("Enter the word that will be used to select sentences:"))
If TargetWord = "" Then MsgBox "No word entered." & vbCr & vbCr & "EXITING MACRO": End
ReDim ArrayOfSentences(0)
Set myOriginalDoc = ActiveDocument
Set myHiddenDoc = Documents.Add(, , wdNewBlankDocument, False)
On Error GoTo Ending 'if an error interferes, I want to at least close HiddenDoc
'*********************************
'*******Transfer the text*********
myOriginalDoc.Select
Selection.Copy
myHiddenDoc.Select
Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:=wdInLine, DisplayAsIcon:=False
'*********************************
'*********************************
myHiddenDoc.Bookmarks("\StartOfDoc").Select
'****Set search parameters***************
Selection.Find.ClearFormatting
With Selection.Find
.Text = "": .Replacement.Text = "": .Forward = True: .Wrap = wdFindStop
.Format = False: .MatchCase = False: .MatchWholeWord = False: .MatchWildcards = True
.MatchSoundsLike = False: .MatchAllWordForms = False
End With
'****************************************
Do
Selection.Find.Text = "[^13.\?\!]{1}[!.\?\!^13]@[.\!\?]{1}"
Selection.Find.Execute
OldValue = Selection.Start
Selection.Find.Text = "<*>*[.\!\?]{1}"
Selection.Find.Execute
If InStr(1, Selection.Text, TargetWord, vbTextCompare) > 0 Then
ArrayOfSentences(UBound(ArrayOfSentences)) = Selection.Text
ReDim Preserve ArrayOfSentences(UBound(ArrayOfSentences) + 1)
End If
Selection.Collapse wdCollapseEnd
Selection.MoveLeft wdCharacter, 1, False
Loop While Selection.Start > OldValue
Ending:
myHiddenDoc.Close False
DoEvents
If Err.Number > 0 Then On Error GoTo 0: Resume 'go back to any error after closing HiddenDoc
ExcelBusiness ArrayOfSentences
End Sub
Function ExcelBusiness(ArrayOfSentences() As String)
Dim sen As Long 'a counter to loop through the sentences
Dim myNewDoc As Document
Set myNewDoc = Documents.Add
For sen = 0 To (UBound(ArrayOfSentences) - 1)
myNewDoc.Bookmarks("\EndOfDoc").Select
Selection.TypeText ArrayOfSentences(sen) & vbCr
Next
myNewDoc.Select
Selection.ConvertToTable wdSeparateByParagraphs, , 1, , wdTableFormatNone
End Function
[/vba]
I'm also attaching the test document that I have been using. So far so good with my test document. the macro seems to be doing exactly what I want it to.
I was continuing to test just now, and I realized the following:
If you search for "we" for example, then sentences that DON'T have "we" but that do have things like "answer" (see the we in ansWEr?) will be chosen.
I will try and fix this tomorrow.
so for now, beware... if you search for "small" words, you may get incorrect results that contain your small word WITHIN a larger word
If you're looking for such smaller words like this, try - (space)we(space) for your searchQuote:
Originally Posted by Kelly
unfortunately, Johnske, (space)we(space) won't work because of the following line:
TargetWord = Trim(InputBox("Enter the word that will be used to select sentences:"))
the "trim" function gets rid of preceding or trailing space characters. I don't know exactly what made me use the trim function. Habit, I guess.
However, taking out the trim part would not entirely solve the problem. If I took out trim, and then searched for " we " - then any case where "we" is the first word in the sentence would not be chosen.
so.... I've got more work to do
Also, it ocurred to me that I have not tested my macro under the circumstance where NO instances of the search text are found. In that case, I should modify the macro so that it doesn't open a blank document in which to create a table if there is no data to include in the table.
You could use a RegExp to find the string. The code below would count " we " but not "answer" as a match.
Cheers
Dave
[vba]
Sub FindString()
Dim Regex As Object, MatchCol As Object
Dim TargetWord As String
TargetWord = Trim(InputBox("Enter the word that will be used to select sentences:"))
If TargetWord = "" Then MsgBox "No word entered." & vbCr & vbCr & "EXITING MACRO": End
Set Regex = CreateObject("vbscript.regexp")
With Regex
.Global = True
.ignorecase = False
'insert string to be found inside wound boundary markers, ie \bstring\b
.Pattern = "\b" & TargetWord & "\b"
End With
ActiveDocument.Select
Set MatchCol = Regex.Execute(Selection)
Select Case MatchCol.Count
Case 0
MsgBox "string " & TargetWord & " not found"
Case 1
MsgBox TargetWord & " found " & MatchCol.Count & " time"
Case Else
MsgBox TargetWord & " found " & MatchCol.Count & " times"
End Select
Set MatchCol = Nothing
Set Regex = Nothing
End Sub
[/vba]
Thanks, Dave (brettdj)!
I have a question:
when you use "Set Regex = CreateObject("vbscript.regexp")" does that mean that the person who will use the macro does NOT have to go add a reference to the vbscript library using the VBE ?
In the past, I have used the vbscript regexp by usind a Dim statement, a la "Dim myRexExpObject As New RegExp" which required the macro user (if you ever copied and pasted the macro) to add a reference to the vbscript library using the visual basic editor.
I'm hoping you will tell me that the CreateObject function circumvents that little problem. If so, I'm a convert!!!
so tell me a bit more about CreateObject, and thank you very much for educating me!
Hello All,
Just returned from a weekend away or would have posted earlier. I think Kelly's first thought was correct and this is fairly simple.
All you need to do is exactly as per the original request - search for a string and copy the sentence. It doesn't really matter what the string is - and Word's Find accepts a subset of regular expressions so there shouldn't normally be a need to use the RegExp object.
[VBA] ' (set up your Find using the Selection.Find Object)
Do While Selection.Find.Execute
MsgBox Selection.Sentences(1)
Loop
[/VBA]
Obviously you want to do something other than the Msgbox and there is the presumption that the string being searched for does not itself contain a sentence delimiter,
Oh you're kidding me! :eek:
the selection object has a "sentences" property/method ????
well.... ain't my face red :blush
I don't know why, but I was convinced there was no such thing as .sentences(1)
I know there are .paragraphs(x) and .words(x), but for some reason I was thinking "sentences" was one of those seeminly logical things that somehow got left out of Word VBA. Like selection.pages(x).Select
... don't tell me there actually is a .pages(x) .... ? There isn't, right?
Hi Kelly,
Yes there are a few of those. :)Quote:
Originally Posted by Kelly
And, no, there isn't a pages collection, but ..
.. there is a built-in (I think Word calls them predefined) bookmark that does almost the same ..
[VBA] Selection.Bookmarks("\Page").Select[/VBA]
Okay, now I'm not feeling quite so ridiculous about my original solution.
I decided to test Tony's suggestion. I only wanted to test what would happen with .sentences(1) if the sentence contained a hyperlink. I remembered that my original macro had problems when there was a hyperlink or a field in the sentence, which is why I copied everything as text before running the macro. So I figured Tony's idea was obviously elegant and ideal, but I wanted to see if it would still be necessary to make sure we had a TEXT ONLY version of the document before running the macro.
Well....
hyperlinks are apparently not a problem, but...
I discovered some unexpected issues. Firstly, we still have the problem of the "little words." For example, I searched my sample page for "to" and the first word selected was "Houston"
But, even worse....
it found Houston, and it just so happens that "Houston" is not in a sentence. It is in a sub-heading. BUT BUT BUT.... apparently Word VBA has decided that sub-headings are still part of sentences. So, the sample text was:
Bush turns up the heat on N. Korea at APEC summit
Houston Chronicle - 12 hours ago
Putting security threats at the top of his agenda, President Bush on Saturday won commitments from Russian and Asian leaders to press the North New York Times Koreans to eliminate their nuclear weapons programs.
(That "New York Times" thing is a hyperlink that I threw in for testing. I wanted to search for the sentence that begins with "Putting" and then see if the hyperlink would interfere with selecting the sentence.)
Anyway, when I search for "to," the "sentence" that is selected is ALL of the following:
Bush turns up the heat on N. Korea at APEC summit
Houston Chronicle - 12 hours ago
Putting security threats at the top of his agenda, President Bush on Saturday won commitments from Russian and Asian leaders to press the North New York Times Koreans to eliminate their nuclear weapons programs.
I still think that Tony's solution is more elegant than mine. And, in reality, the occasional "non-sentences" that Word would generate would probably not be a big problem for whatever Ron is trying to do.
However, if we ever had to be 100% sure that what we are getting is truly a sentence, then ".sentences(x)" is not foolproof
Thanks a million for that! I knew you would be understanding! <big grin>Quote:
Originally Posted by TonyJollans
Although, my macro cannot offer a 100% guarantee of "sentence-hood" either, because how could we EVER ensure the presence of a subject and a predicate!!!!!!!Quote:
Originally Posted by Kelly
:bug:
Hi Kelly,
Your sample looks ike something lifted off the web. The only reason I can see for the results you get is if it has manual line breaks instead of paragraph marks. Can you post your test doc?
As for the 'little words' problem - that is standard Find behaviour - if you want words use wildcards and "<to>" as a search string.
I must say, I do like the idea of Word refusing to accept grammatically incorrect sentences.
Yes, I needed hyperlinks, so I figured I would copy text from the web. I copied my test paragraphs from Google news.Quote:
Originally Posted by TonyJollans
drumroll please....
you are right! (thank god, because I really wanted .sentences(1) to work!!!)
when I manually type the same headings and other text, the macro "grabs" the correct pieces of text.
however, when I use the stuff I pasted from the web, the macro grabs the whole mini-article!
Here's a tester for you. I butchered my original macro so it looks like this:
[vba]Sub TestingSentenceSelection()
TargetWord = Trim(InputBox("Enter the word that will be used to select sentences:"))
If TargetWord = "" Then MsgBox "No word entered." & vbCr & vbCr & "EXITING MACRO": End
Set myOriginalDoc = ActiveDocument
myOriginalDoc.Bookmarks("\StartOfDoc").Select
'****Set search parameters***************
Selection.Find.ClearFormatting
With Selection.Find
.MatchWildcards = False
.Text = "": .Replacement.Text = "": .Forward = True: .Wrap = wdFindStop
.Format = False: .MatchCase = False: .MatchWholeWord = False
.MatchSoundsLike = False: .MatchAllWordForms = False
End With
'****************************************
Selection.Find.Text = TargetWord
myBoolean = Selection.Find.Execute
If myBoolean = True Then Selection.Sentences(1).Select: MsgBox "I have selected the sentece"
End Sub[/vba]
run the macro and search for "Houston," and you will now see that the macro runs correctly. (because I manually typed the Houston article)
then run the macro and search for "Xinhua" (see 2nd article) and watch how the whole thing gets selected.
Yes, it's those manual line breaks - chr(11) - Word doesn't treat them as delimiters - bit poor really.
Guess we need to wait for ron to come back and see what he needs.
As Tony stated above, Word does have RegExp like searching - I tend to stick to RegExp as I know it better
Yes, late binding avoids adding the reference. If I was using early binding I'd do it as belowQuote:
Originally Posted by Kelly
Dim myRexExpObject As RegExp
Set myRexExpObject = New RegExp
Cheers
Dave
All,
Thanks for the help.
It will take me a while to go though and understand all of your suggestions. I have also been working on my problem with a different approach.
It appears I solved the problem of finding a word and copying the sentence that contains the word. I am having trouble opening an Excel document and pasting the coped sentence in. My statements and function to open the Excel document does not work from Word although I did test them in Excel and they worked, any thoughts on this? I am also not sure about my code to copy each sentence found to the next row.
In addition I will have to address in my code the circumstance of having the same word multiple times within the same sentence.
I realize there are many way to approach the same problem and I am open all suggestions. Thanks again.
My code is below:
Note: I have barrowed some code from several sources.
Also any tips on coping code into a message on this forum. I had a hard time formatting.
Ron
[VBA]Sub FindWordCopySentence()
Dim aRange As Range
Dim intRowCount As Integer
intRowCount = 1
Set aRange = ActiveDocument.Range
With aRange.Find
Do
.Text = "shall" ? the word I am looking for
.Execute
If .Found Then
aRange.Expand Unit:=wdSentence
aRange.Copy
'checking if file is open if not open file
If Not WorkbookIsOpen("SOW_shall.xls") Then
Workbooks.Open Filename:="C:\SOW_shall.xls"
End If
'my attempt to copy each sentence found to the next row in excel document
Sheets("Sheet1").Select
Cells(intRowCount, 1).Select
aRange.Paste
intRowCount = intRowCount + 1
Loop While .Found
End With
End Sub
? function to check if file is open
Private Function WorkbookIsOpen(wbname) As Boolean
'Returns TRUE if the workbook is open
Dim x As Workbook
On Error Resume Next
Set x = Workbooks(wbname)
If Err = 0 Then WorkbookIsOpen = True _
Else WorkbookIsOpen = False
End Function[/VBA]
Hi Ron,
Expanding the Range is fine but, if doing so, to deal with the multiple occurrences - indeed to make your loop work - you need to collapse the range after you've extracted the sentence and before looking for the next one. The reason for this is that the Find redefines the Range and later searches start after the redefined range, BUT if you have further redefined it, later searches assume you want to look only in the newly defined range - except when it's collapsed when that makes no sense - did that all make sense??
After the line
Arange.Copy
add the line
aRange.Collapse wdCollapseEnd
Now for the Excel bit. You need to address an Excel object before you can address Workbooks, etc. Whilst I would normally applaud the use of a separate Function, in this case it rather complicates it and I would bring all the code inline. Some quick changes to your code and this should work ..
[VBA] Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
Dim intRowCount As Integer
intRowCount = 1
Set aRange = ActiveDocument.Range
With aRange.Find
Do
.Text = "shall" ' the word I am looking for
.Execute
If .Found Then
aRange.Expand Unit:=wdSentence
aRange.Copy
aRange.Collapse wdCollapseEnd
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.Workbooks.Open("C:\SOW_shall.xls").Sheets("Sheet1")
intRowCount = 1
End If
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
'checking if file is open if not open file
'If Not WorkbookIsOpen("SOW_shall.xls") Then
'Workbooks.Open FileName:="C:\SOW_shall.xls"
'End If
'GetOpenWorkbook("C:\SOW_shall.xls").sheets("Sheet1").Cells(intRowCount, 1).Select
'GetOpenWorkbook("C:\SOW_shall.xls").sheets("Sheet1").Paste
'my attempt to copy each sentence found to the next row in excel document
'Sheets("Sheet1").Select
'Cells(intRowCount, 1).Select
'aRange.Paste
intRowCount = intRowCount + 1
End If
Loop While .Found
End With
If Not objSheet Is Nothing Then
appExcel.workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
End Sub
[/VBA]
Tony,
That worked great!!
I see I need to become familiar with creating objects.
I have some more work to do on this project.
I would like to remove the formatting before pasting. I think that would be done with paste special. In addition I would like to copy the paragraph number and heading which contained the sentence, and also paste into the Excel document.
I am going to try to hammer out those requirements. I hope all of you are available if I run into trouble.
In the event I require help would I post in the same thread or start a new one?
Best Regards,
Ron
Ah, the really difficult questions :)
If it relates to the same code it's probably as well to post here. If it's a standalone question, a new thread. Sometimes a new thread may get the attention of more people, but there are no rules about it - just do as you think best.
Hello again,
I tried to work out the remainder of the requirement for my macro but have not had any luck. I tried several things but none worked out.
The macro should in addition to finding the specified word and copying the sentence that contains the word to an Excel workbook, I would also like the paragraph heading and number copied to the same Excel workbook in the same row, the number in one column the heading in another.
The closest I came was to use find, searching up for bold text, all the paragraph headings and numbers are bold, although I did not know how to start the search from the previously selected sentence so the search just stated from the bottom of the page.
The code I am using is what Tony posted on 11-22-04.
I am including a sample of text from a Word document for which the macro will be used. I?m not sure if the formatting will copy into this post but the paragraph numbers and headings are bullets.
Thanks
Ron
Sample:
1.1 Order of Precedence
In the event of a conflict between the SOW, specifications, or other documents, the order of precedence for the contractual documents is listed in the following descending order:
a. Purchase Order
b. This SOW
c. Other specifications and standards referenced in this SOW
The contractor shall notify the customer of any conflicting requirements in the contract SOW and system specifications.
2. REQUIREMENTS
2.1 Modification
The contractor shall perform modifications listed in this SOW. The modification requirements are contained in the Statement of Work Systems Modifications. Refer to Appendix C.
2.2 Technical Publications
The contractor shall provide documentation. Two sets shall be provided in accordance with the Integrated Schedule.
Hi Ron,
You need to be precise in what you're searching for and, depending on your document there might be a better way with styles, but maintaining two different Find objects will allow you to search back from your sentence to find some bold text without disrupting the first Find, something like this ..
[VBA]
:
:
Dim aRange As Range
Dim bRange As Range
:
Set aRange = ActiveDocument.Range
Set bRange = ActiveDocument.Range
:
:
aRange.Copy
bRange.End = aRange.End
bRange.Collapse wdCollapseEnd
bRange.Find.ClearFormatting
bRange.Find.Font.Bold = True
With bRange.Find
.Text = ""
.Forward = False
.Wrap = wdFindStop
.Format = True
End With
bRange.Find.Execute
aRange.Collapse wdCollapseEnd
:
:[/VBA]
Quick query regarding searching for little words ("to" etc.) - did you try setting the .MatchWholeWord property of the search to TRUE?
Hi Tony,
Thanks for the latest suggestion, I will give it a try and let you know how it goes.
Ron
Hello,
I?m back on this project.
It works as required thanks to Tony and others. Although I do have a problem if I copy the data to a sheet other than sheet 1. If I change the code to copy to another sheet only a portion of the data is copied. It is the same result if I name the sheets and use the sheet name in the code. Ultimately I will be searching for several words and coping to a different sheet for each word so I would like the ability to select which sheet to copy the data to.
Your continued help is greatly much appreciated.
My current code is below. If it is possible in this forum I can attach a sample document if required.
Regards,
Ron
[VBA]Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim aRange As Range
Dim bRange As Range
Dim intRowCount As Integer
Dim strFileNameAndPath As String
Dim lngDisplayVal As Long
Dim PathAndFileName As String
On Error Resume Next
'open dialog box for user to select file
'and put path and file name in varable
With Application.Dialogs(wdDialogFileOpen)
lngDisplayVal = .Display
strFileNameAndPath = WordBasic.FileNameInfo$(.Name, 1)
End With
If lngDisplayVal <> -1 Then
MsgBox prompt:="Procedure canceled. Must select a file."
Exit Sub
End If
intRowCount = 3
Set aRange = ActiveDocument.Range
Set bRange = ActiveDocument.Range
With aRange.Find
Do
.Text = "shall" ' search word
.Execute
If .Found Then
aRange.Expand unit:=wdSentence
aRange.Copy
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.Workbooks.Open(strFileNameAndPath).Sheets("Sheet2")
End If
objSheet.Cells(intRowCount, 3).Select
objSheet.Paste
bRange.End = aRange.End
bRange.Collapse wdCollapseEnd
bRange.Find.ClearFormatting
bRange.Find.Font.Bold = True
With bRange.Find
.Text = ""
.Forward = False
.Wrap = wdFindStop
.Format = True
End With
bRange.Find.Execute
bRange.Copy
objSheet.Cells(intRowCount, 1).Select
objSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:= _
False
intRowCount = intRowCount + 1
aRange.Collapse wdCollapseEnd
End If
Loop While .Found
End With
If Not objSheet Is Nothing Then
appExcel.Workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
End Sub[/VBA]
Just had a quick look and there is no obvious reason why simply changing a Sheet name in a single line should have the effect you say. It'll be a day or so before I can look at this properly but I will come back. Meanwhile if you can post a sample document it would help (in the advanced input screen scroll down and under "Additional Options" there is a button labeled "Manage Attachments")
Hi Tony,
Sorrry for the delay.
Attached is a sample document with the macro.
Thanks.
Ron
Hi Ron and Others,
I was tasked with creating a Requirements Collection Sheet a couple of days ago for a work project (finding every sentence with "shall" in 30+ reports - thats a total of 10,000 items! Not having any VBA experience this task was daunting!
Using your macro cut my work load from a couple of months of manually cutting and pasting, to a few days.
I just wanted to say thanks for your effort.
I hope you get this, (even if it is an old thread!)
Thank you, SelimT, and thank you for posting, as well as searching and finding, which action alone puts you in about the top 2% - most people ask first and think later, if at all.
I know this is an old thread, and I appreciate the guidance since my VBA is very rusty! The .Find function appears to be the function of choice when searching for text in a word document and copying the identified sentence to an excel worksheet. However, I'd like to search for sentences containing one of several text values, or an array of strings. Can anyone provide guidance on this? Do I have to read each sentence line by line and search for one of the (in my case 2) words? Thanks in advance.
It would have been better had you started a new thread, however you can however find a sentence containing a word or words using Range.Find e.g.
Code:Sub Macro1()
Const strFind As String = "lorem|ipsum" 'The words to find, each separated by '|'
Dim vFind As Variant
Dim orng As Range, oText As Range
Dim i As Long
vFind = Split(strFind, "|")
For i = LBound(vFind) To UBound(vFind)
Set orng = ActiveDocument.Range
With orng.Find
Do While .Execute(FindText:=vFind(i))
Set oText = orng.Sentences(1)
oText.Select
MsgBox vFind(i) & vbCr & oText.Text
orng.Collapse 0
Loop
End With
Next i
lbl_Exit:
Exit Sub
End Sub
Quote:
Originally Posted by TonyJollans
Thank you very much for the example - it helped a LOT. I was able to look up your usage and pull pieces into some other code posted earlier. Frankly, I'd start from ground zero, but I'm no VBA expert, but can read code and understand the logic pretty well having programmed a long time ago.
I got a little frustrated starting in Excel because I kept getting errors with using "ActiveDocument" and "with Range.Find" (needed to define variables??) So, I pulled it over to Word, and those errors disappeared. My only issue now is that the code finds all the sentences with the first word in the array, and then all the sentences with the second word. I really need the code to read the document pulling out each sentence containing either of the two words and pasting the sentences into excel as it identifies them. There has to be an easy way to do this. If someone can point me in the right direction, I'd really appreciate it! I'll be working on it here and there because I don't have dedicated time to focus on it unfortunately. I know this is pretty simple to the experts out there. Thanks in advance.
Sub FindWordCopySentence()
Dim appExcel As Object
Dim objSheet As Object
Dim intRowCount As Integer
Const strFind As String = "shall|will" 'The words to find, each separated by '|'
Dim vFind As Variant
Dim orng As Range, oText As Range
Dim i As Long
intRowCount = 1
vFind = Split(strFind, "|")
For i = LBound(vFind) To UBound(vFind)
Set orng = ActiveDocument.Range
With orng.Find
Do While .Execute(FindText:=vFind(i))
If .Found Then
orng.Expand Unit:=wdSentence
orng.Copy
orng.Collapse wdCollapseEnd
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.workbooks.Open("C:\Users\TEST").Sheets("Sheet1")
intRowCount = 1
End If
objSheet.Cells(intRowCount, 1).Select
objSheet.Paste
intRowCount = intRowCount + 1
If objSheet Is Nothing Then
Set appExcel = CreateObject("Excel.Application")
Set objSheet = appExcel.workbooks.Open("C:\Users\Test").Sheets("Sheet1")
intRowCount = 1
End If
End If
Loop
End With
Next
If Not objSheet Is Nothing Then
appExcel.workbooks(1).Close True
appExcel.Quit
Set objSheet = Nothing
Set appExcel = Nothing
End If
Set orng = Nothing
End Sub
Actually there isn't an easy way because unless you can define a pattern that fits the multiple terms that you want to find, VBA can only look for one thing at a time. E.g., it just can't look for Red or Blue or Green or Pink or Orange or Yellow etc
In this case there is a relatively simple pattern so try:
Code:Sub FindWordCopySentence()
Dim oApp As Object
Dim oSheet As Object
Dim lngIndex As Long
Const strFind As String = "<[shawi]{2,3}ll>"
Dim orng As Range
lngIndex = 1
vFind = Split(strFind, "|")
If oSheet Is Nothing Then
Set oApp = CreateObject("Excel.Application")
Set oSheet = oApp.workbooks.Open("D:\Data Stores\Sentence List.xlsx").Sheets("Sheet1")
lngIndex = 1
End If
Set orng = ActiveDocument.Range
With orng.Find
.Text = strFind
.MatchWildcards = True
While .Execute
If UCase(orng.Text) = "SHALL" Or UCase(orng.Text) = "WILL" Then
orng.Expand Unit:=wdSentence
oSheet.Cells(lngIndex, 1).Value = orng.Text '.Select
lngIndex = lngIndex + 1
End If
orng.Collapse wdCollapseEnd
Wend
End With
If Not oSheet Is Nothing Then
oApp.workbooks(1).Close True
oApp.Quit
Set oSheet = Nothing
Set oApp = Nothing
End If
Set orng = Nothing
lbl_Exit:
Exit Sub
End Sub
Greg, I wanted to thank you for the quick response. I've not had a chance to work on my code with your suggestion, but when I do, I'll let you know. And thanks for letting me know why all the "shalls" were found prior to the "wills." I suspected that VB could only search one item at a time with the .Find, but nice to know for certain. My code is in Word VB and I'm exporting the results to an Excel file. However, I do see how to incorporate your logic. Thanks again!
Greg -- Now that I finally have time, I hope you can help me with a little confusion I have. In the original, I see how the logic loops through the array of words to find ("strFind") by splitting up the array and searching each word at a time ("vFind") - if found, copies and pastes accordingly. The VB code works pretty well, too but only finds one word at a time (my conundrum). If you have a moment, could you help me understand the following in your code:Quote:
Originally Posted by Aerogal
You Split the variable "vFind," but never use the results (why).
In the With loop, you set "orng.Find.Text" to the string variable "strFind" array contents. Walking through execution, the logic is therefore never true for the corresponding "If" statement.
Any help would be greatly appreciated. I can search for 1 word at a time. Would like to search for 2... :think:
Aerogal,
That was just sloppiness on my part. vFind is not used and strFind is not an array but a wildcard string expression. The difficult (if not impossible part) of finding two or more different words at a time is creating a wildcard pattern that finds the desired words and excludes al others. In the code I posted earlier, I validated that regardless of what was found, only shall and will were further processed. Here is simplified version without validation. Shall and will are still processed but so is "hill, hall, wall" etc.
Code:Sub FindTwoDifferentWords()
Const strFind As String = "<[shawi]{2,3}ll>"
Dim orng As Range
Set orng = ActiveDocument.Range
With orng.Find
.Text = strFind
.MatchWildcards = True
'Do something globally"
.Replacement.Font.Bold = True
.Execute Replace:=wdReplaceAll
'Or
'While .Execute
'orng.Select 'Do something with the found range.
'orng.Collapse wdCollapseEnd
'Wend
End With
lbl_Exit:
Exit Sub
End Sub
Greg, Thank you. I feel very embarrassed, and your response prompted me to learn more about the wildcard feature (word.mvps.org/faqs/general/usingwildcards.htm). It is a lot more powerful than I had known only days ago.
My test document contained upper case words, so my initial macro never ended. I modified the wildcard to be:
I tested it on my test document and then a "real" document. Works like a charm. I would have never gotten this far without your help. Thank you so very much.Code:Const strFind As String = "<[SshaWwi]{2,3}ll>"
Aerogal,
You are welcome. Glad I could help.