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.