[dba-Tech] Word VBA question

Stuart McLachlan stuart at lexacorp.com.pg
Sat Nov 9 05:59:42 CST 2019


Just a  a WAG, but the faliure to add may be to do with your nested WITHs.

Try it with fully qualified references without any WITH...END WITH blocks.


On 9 Nov 2019 at 6:09, Susan Harkins wrote:

> 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
> 
> _______________________________________________
> 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