-
Right, she works! List reduced to ~3000 names and people who are definitely going to be encountered has helped. It takes about 7-10 minutes to process on each document.
[VBA]
Option Explicit
Function ReplaceWord(inDoc As Document, j As Long) As String
Dim wrdPara As Paragraph
Dim wrdRef As String
Set wrdPara = inDoc.Paragraphs(j)
wrdRef = wrdPara.Range.Text
'remove the paragraph mark:
wrdRef = Left(wrdRef, Len(wrdRef) - 1)
ReplaceWord = wrdRef
End Function
Sub Names()
Dim docCurrent As Document
Dim docRef As Document
Dim j As Long
Dim r As Range
Dim wrdRef As String
Set docCurrent = ActiveDocument
Set docRef = Documents.Open("d:\Anonymouse\Checklists\checklist.doc")
For j = 1 To docRef.Paragraphs.Count
Set r = docCurrent.Range
' gets the next word from reference doc
wrdRef = ReplaceWord(docRef, j)
With r.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = wrdRef
.Replacement.Font.Color = wdColorRed
.Replacement.Text = "[NAME REMOVED]"
.MatchWholeWord = True
.MatchCase = True
.Execute Replace:=wdReplaceAll
End With
Next
docRef.Close
Set docRef = Nothing
End Sub
[/VBA]
Only issue at the moment, is I want to bath run it on ~100 documents overnight which I have a macro for, however when I ran it last night it did the first 19 of them and then I got a windows error saying memory was low and it was going to increase my virtual memory size! I'm not sure why it would do this as it should be closing each file after it's finished.
Still, even if I can run them in batches of 15 that's fantastic compared to the alternative of going through them manually.
Orge.
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules