简体   繁体   中英

Word VBA: Modify range based on conditional statement

I'm working on a script that extracts parenthetical in-text citations like '(Author, 1992)' from a word doc and copies them to another doc. The code works well to extract all parentheticals, but there are cases where a citation is in the form of "as quoted in Author (1992)..." Where a parenthetical starts with a number, I would like to pull the previous word into the range and copy both over into the new doc. In the above scenario then, we would get 'Author (1992)' rather than just '(1992)' as the code currently operates. I have tried writing a conditional to modify the range using.MoveStart, but it is not capturing the preceding word when the range copies over to the new doc. I know I'm missing some small, significant piece here but can't find any obvious (to me) solutions on other forums questions. Thanks

Sub CopyRefs()
  Dim SearchRange As Range, DestinationDoc$, SourceDoc$
  DestinationDoc$ = "Extracted_References.doc"
  SourceDoc$ = ActiveDocument.Name
  Documents.Add DocumentType:=wdNewBlankDocument
  ActiveDocument.SaveAs DestinationDoc$, wdFormatDocument
  Documents(SourceDoc$).Activate
  Set SearchRange = ActiveDocument.Range
    
  With SearchRange.Find
      Do While .Execute(findText:="\(*\)", _
        MatchWildcards:=True, _
        Wrap:=wdFindStop, Forward:=True) = True
             
          'this part doesn't seem to work when condition is satisfied 
          If SearchRange.Text Like "\(#*" Then 
              SearchRange.MoveStart wdWord, -1
          End If
          
          'a parenthetical number like (1992) will copy over to new doc but seems_
          'like range not updating to include preceding word in previous step
          Documents(DestinationDoc$).Range.InsertAfter SearchRange.Text & vbCr
      Loop
  End With
End Sub

Thanks to jonsson for pointing out the syntax error. Code below functions as intended.

Sub CopyRefs()
  Dim SearchRange As Range, DestinationDoc$, SourceDoc$
  DestinationDoc$ = "Extracted_References.doc"
  SourceDoc$ = ActiveDocument.Name
  Documents.Add DocumentType:=wdNewBlankDocument
  ActiveDocument.SaveAs DestinationDoc$, wdFormatDocument
  Documents(SourceDoc$).Activate
  Set SearchRange = ActiveDocument.Range

  With SearchRange.Find
      Do While .Execute(findText:="\(*\)", _
        MatchWildcards:=True, _
        Wrap:=wdFindStop, Forward:=True) = True
             
          'Removed backslash since "(" doesn't need to be escaped
          If SearchRange.Text Like "(#*" Then
              SearchRange.MoveStart wdWord, -1
          End If
          
          'copies range to new doc
           Documents(DestinationDoc$).Range.InsertAfter SearchRange.Text & vbCr
           
          'collapses range to prevent infinite loop when If condition met
          SearchRange.Collapse wdCollapseEnd
      Loop
  End With
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM