[dba-Tech] Word VBA question

Susan Harkins ssharkins at gmail.com
Sat Nov 9 05:09:28 CST 2019


Yes; before the find is triggered, .Found is false -- nothing has been
found. When I move the loop after .Execute, the loop iterates, but it
doesn't add the found strings to the new document. When there's no loop,
everything works as expected one time -- it finds and copies the strings to
the new document once. 

The documents will have been strings to copy. 

Susan H. 

-----Original Message-----
From: dba-Tech <dba-tech-bounces at databaseadvisors.com> On Behalf Of Jim
Lawrence
Sent: Friday, November 8, 2019 8:23 PM
To: Discussion of Hardware and Software issues
<dba-tech at databaseadvisors.com>
Subject: Re: [dba-Tech] Word VBA question

Hi Susan:

Is that false condition what you are expecting?

Jim

----- Original Message -----
From: "Susan Harkins" <ssharkins at gmail.com>
To: "Discussion of Hardware and Software issues"
<dba-tech at databaseadvisors.com>
Sent: Friday, November 8, 2019 6:17:10 AM
Subject: Re: [dba-Tech] Word VBA question

There's no count with a Do While loop -- the loop continues as long as the
condition is true. As Stuart pointed out my loop is always false because the
search string hasn't been found yet. It works after the Execute method, but
the values aren't copied to the new document. 



Susan H. 


Hi Susan:

I know nothing (very little) about working with documents but when using a
do..while or for-next loop, getting the count value is most important.
States can change, in some cases for no apparent reason. A fixed value will
not.

If there is a problem with getting an appropriate response that is where I
would start looking.

Jim 

----- Original Message -----
From: "Susan Harkins" <ssharkins at gmail.com>
To: "Discussion of Hardware and Software issues"
<dba-tech at databaseadvisors.com>
Sent: Thursday, November 7, 2019 12:17:17 PM
Subject: Re: [dba-Tech] Word VBA question

I tried moving it to just after Execute -- that didn't work either. 

Do While rng.Find doesn't work either. 

Susan H 


The Do... Loop will not execute since rng.Find.Found is false at the start.

A classic exampe of the difference between

DO WHILE
...
LOOP

versus

DO
.....
LOOP WHILE

Whaat happens if you move the DO WHILE to after the .Execute and the LOOP
before the final END WITH?


On 7 Nov 2019 at 14:37, Susan Harkins wrote:

> I had to let this go for awhile but I've got it mostly worked out, 
> except for the right loop.
> 
> This procedure creates a new document with a table for storing each 
> acronym, its, definition, and the page number. Right now, it works 
> fine for the first acronym found, but I can't get the loop correct to 
> keep it going until it's found all of the acronyms.
> 
> Any help? 
> 
> At this point, don't worry if the definition isn't exact. I haven't 
> been able to test it for a full document -- can't do that until I can 
> get the loop to work. In addition, it's rather ugly code -- I'll clean 
> it up later.
> 
> Code follows -- and thanks! - Susan H. 
> 
> 
> Sub GetAcronyms()
> 'Create new document with acronyms, definitions, and page numbers for 
> active document.
> 
> Dim source As Document
> Dim target As Document
> Dim rng As Range
> Dim tbl As Table
> Dim strAnronym As String
> Dim strDefintion As String
> Dim intAcronym As Integer
> Dim strRngCopy As String
> 
> Set source = ActiveDocument
> Set target = Documents.Add
> 
> 'Add Table object to target document to organize anacronyms and 
> definitions. With oDoc_Target
>     Set tbl = target.Tables.Add(target.Range, 2, 3)
>     With tbl
>         'Format the table a bit
>         'Insert headings
>         .Range.Style = wdStyleNormal
>         .AllowAutoFit = False
>         .Cell(1, 1).Range.Text = "Acronym"
>         .Cell(1, 2).Range.Text = "Definition"
>         .Cell(1, 3).Range.Text = "Page"
>         'Set row as heading row
>         .Rows(1).HeadingFormat = True
>         .Rows(1).Range.Font.Bold = True
>         .PreferredWidthType = wdPreferredWidthPercent
>         .Columns(1).PreferredWidth = 20
>         .Columns(2).PreferredWidth = 70
>         .Columns(3).PreferredWidth = 10
>     End With
> End With
> 
> Set rng = source.Range
> 
> 'Do While rng.Find.Found
> With rng.Find
>     'Use wildcard search to find strings consisting of two or more
>     uppercase
> letters.
>     .Text = "\(<[A-Z]{2,}>"
>     .Forward = True
>     .Wrap = wdFindStop
>     .Format = False
>     .MatchCase = True
>     .MatchWildcards = True
>     'Perform the search
>     .Execute
>         strAcronym = Right(rng, Len(rng) - 1)
>         'Length of strAcronym determines number of words preceding
>         copied. 'Copy acronym definition. intAcronym = Len(strAcronym)
>         rng.Select strDefinition = Selection.MoveLeft(wdWord,
>         intAcronym + 2, True) strDefinition = Selection.Text
> 
>         'Copy acronym, definition, and page number to target table.
>         With tbl
>             tbl.Select
>             Selection.InsertRowsBelow 1
>             tbl.Cell(2, 1).Range = strAcronym
>             tbl.Cell(2, 3).Range.Text =
> rng.Information(wdActiveEndPageNumber)
>             tbl.Cell(2, 2).Range.Text = strDefinition
>         End With
> 
>     End With
> 'Loop
> 
> End Sub
> 
> 
> 
> -----Original Message-----
> From: dba-Tech <dba-tech-bounces at databaseadvisors.com> On Behalf Of 
> Salakhetdinov Shamil via dba-Tech Sent: Saturday, August 31, 2019 8:09 
> AM To: Discussion of Hardware and Software issues 
> <dba-tech at databaseadvisors.com> Cc: Salakhetdinov Shamil 
> <mcp2004 at mail.ru> Subject: Re: [dba-Tech] Word VBA question
> 
> Hi Susan --
> 
> I'm not sure what method do you use to find the abbreviation - here 
> are two possible solution cases:
> 
> *** First one ***
> 
> Sub Macro1()
> Dim searchWord As String
> searchWord = "BBB"
> Dim sel As word.Selection
> Set sel = word.Application.Selection
> sel.ClearFormatting
> With sel.Find
> .Text = searchWord
> .Replacement.Text = ""
> .Forward = True
> .Wrap = wdFindContinue
> .Format = False
> .MatchCase = False
> .MatchWholeWord = False
> .MatchWildcards = False
> .MatchSoundsLike = False
> .MatchAllWordForms = False
> End With
> 
> Dim wordFound As Boolean
> wordFound = sel.Find.Execute
> If wordFound Then
> Dim wordLength As Integer
> wordLength = Strings.Len(searchWord)
> Dim wdoc As word.Document
> Set wdoc = word.Application.ActiveDocument
> 
> Dim wordIndex As Integer
> wordIndex = GetWordIndex(wdoc, sel.Words.First.Start) If (wordIndex >
> -1) Then Dim rangeToCopy As word.Range Set rangeToCopy = 
> wdoc.Range(wdoc.Words(wordIndex - wordLength - 1).Start, 
> wdoc.Words(wordIndex - 1).Start) Dim strToCopy As String strToCopy =
> Strings.Trim(rangeToCopy) Debug.Print "'" + strToCopy + "'" End If End 
> If End Sub Function GetWordIndex(wdoc As word.Document, 
> wordStartPosition As Integer) As Integer Dim wordIndex As Integer 
> wordFound = False For wordIndex = 1 To wdoc.Words.Count If 
> (wdoc.Words(wordIndex).Start = wordStartPosition) Then GetWordIndex = 
> wordIndex Exit Function End If Next wordIndex
> 
> GetWordIndex = -1
> End Function
> *** Second one ***
> 
> Sub Macro2()
> Dim searchWord As String
> searchWord = "BBB"
> 
> Dim wdoc As word.Document
> Dim wordIndex As Integer
> Dim wordFound As Boolean
> 
> Set wdoc = word.Application.ActiveDocument wordFound = False For 
> wordIndex = 1 To wdoc.Words.Count If (wdoc.Words(wordIndex) =
> searchWord) Then wordFound = True Exit For End If Next wordIndex
> 
> If wordFound Then
> Dim wordLength As Integer
> wordLength = Strings.Len(searchWord)
> Dim rangeToCopy As word.Range
> Set rangeToCopy = wdoc.Range(wdoc.Words(wordIndex - wordLength - 
> 1).Start, wdoc.Words(wordIndex - 1).Start) Dim strToCopy As String 
> strToCopy = Strings.Trim(rangeToCopy) Debug.Print "'" + strToCopy + 
> "'"
> 
> End If
> End Sub HTH.
> 
> -- Shamil
> 
> P.S. I'm a rare guest here these days - if you have any questions on 
> the subject please e-mail me directly.
> 
> 
> >Tuesday, August  6, 2019 12:21 AM +03:00 from Susan Harkins
> <ssharkins at gmail.com>:
> >
> >Hi everyone!
> >
> >I need to copy a range to a new Word document, but it's a complicated 
> >search. When the search pattern find a match, I need to select the 
> >words to the left -- using the length of the match (which can change, 
> >I'm using wildcards). I'm stumped.
> >
> >An example: 
> >
> >The search string matches (BBB) at the text, Better Business Bureau 
> >(BBB). I need to copy the definition of the acronym, to the left of 
> >BBB, and the acronym. The acronym is easy. But I can't figure out for 
> >the life of me how to set a range to "three words to the left of 
> >BBB".
> >
> >I'd like to avoid using Selection because the editors will be working 
> >with big documents. If that's the only way it can be done, that's the 
> >route I'll go. But I'd rather set a range -- just can' figure out how 
> >to do
> it.
> >
> >Thanks!
> >Susan H. 
> >
> >_______________________________________________
> >dba-Tech mailing list
> >dba-Tech at databaseadvisors.com
> >http://databaseadvisors.com/mailman/listinfo/dba-tech
> >Website:  http://www.databaseadvisors.com
> 
> 
> --
> Salakhetdinov Shamil
> _______________________________________________
> dba-Tech mailing list
> dba-Tech at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/dba-tech
> Website: http://www.databaseadvisors.com
> 
> _______________________________________________
> dba-Tech mailing list
> dba-Tech at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/dba-tech
> Website: http://www.databaseadvisors.com
> 


_______________________________________________
dba-Tech mailing list
dba-Tech at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/dba-tech
Website: http://www.databaseadvisors.com

_______________________________________________
dba-Tech mailing list
dba-Tech at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/dba-tech
Website: http://www.databaseadvisors.com
_______________________________________________
dba-Tech mailing list
dba-Tech at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/dba-tech
Website: http://www.databaseadvisors.com

_______________________________________________
dba-Tech mailing list
dba-Tech at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/dba-tech
Website: http://www.databaseadvisors.com
_______________________________________________
dba-Tech mailing list
dba-Tech at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/dba-tech
Website: http://www.databaseadvisors.com



More information about the dba-Tech mailing list