Script to highlight phrases; when protected?

[TheMongoose]

Good morning,

I am using the following code (thanks to this forum)

Sub FileSave()
'
'Sub Demo()
Dim oRng As Range, arrWords, i As Long, HiLite As Variant
Set oRng = ActiveDocument.Range
With oRng.Find
arrWords = Array("abet", "abscond", "abuse", "amphetamine", "arson", "armed", "asbo", "assault", "bail", "bigamy", "blackmail", "bomb", "bribe", "brothel")
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = False
.Replacement.Text = "^&"
.Replacement.Highlight = True
HiLite = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdYellow
For i = 0 To UBound(arrWords)
.Text = arrWords(i)
.Execute Replace:=wdReplaceAll
While .Execute(Replace:=wdReplaceOne)
oRng.Collapse wdCollapseEnd
MsgBox "You have used a restricted word, please check your document: " & arrWords(i)
Wend
Next
Options.DefaultHighlightColorIndex = HiLite
End With
Set oRng = Nothing
ActiveDocument.Save
End Sub



To look for certain words used within a document, can someone educate me as to how to make this work when the document is protected? Currently if it is you get a 4605 error - this command is not available " .Execute Replace:=wdReplaceAll"

I have a spellcheck macro that works with a protected doc so looking at that it appears to be something to do with

oDoc.Unprotect Password:=""
and
Select Case oDoc.ProtectionType

but I can't make it work :(

[Frosty]

You're close, you just need something like the following.

However- if the documents are protected with a password, you'll need to know the password both in order to unprotect and in order to reprotect with the same password. If there is no password protection, then you don't need to use the Password:="" thing.


Sub FileSave()
Dim oRng As Range, arrWords, i As Long, HiLite As Variant
Dim lProtectionType As WdProtectionType

'get the protection type, if any
lProtectionType = ActiveDocument.ProtectionType
'and unprotect, if necessary
If lProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect
End If

Set oRng = ActiveDocument.Range
With oRng.Find
arrWords = Array("abet", "abscond", "abuse", "amphetamine", "arson", "armed", "asbo", "assault", "bail", "bigamy", "blackmail", "bomb", "bribe", "brothel")
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = False
.Replacement.text = "^&"
.Replacement.Highlight = True
HiLite = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdYellow
For i = 0 To UBound(arrWords)
.text = arrWords(i)
.Execute Replace:=wdReplaceAll
While .Execute(Replace:=wdReplaceOne)
oRng.Collapse wdCollapseEnd
MsgBox "You have used a restricted word, please check your document: " & arrWords(i)
Wend
Next
Options.DefaultHighlightColorIndex = HiLite
End With
Set oRng = Nothing
'restore the protection type, if any, before the save
If lProtectionType <> wdNoProtection Then
ActiveDocument.Protect lProtectionType
End If
ActiveDocument.Save
End Sub

[gmaxey]

If you have a large document with lots of restricted word usage then your code as written could drive a user nuts. You display a message each time a restricted word is located and you don't provide and break out. You might consider the following changes:

Dim oRng As Range, arrWords As Variant, i As Long
Dim strRestricted As String, lngCount As Long, strThisWord As String
Dim bList As Boolean
Set oRng = ActiveDocument.Range
With oRng.Find
arrWords = Array("abet", "abscond", "abuse", "amphetamine", "arson", "armed", "asbo", "assault", "bail", "bigamy", "blackmail", "bomb", "bribe", "brothel")
.ClearFormatting
.MatchWholeWord = False
For i = 0 To UBound(arrWords)
.Text = arrWords(i)
lngCount = 1
bList = False
While .Execute
bList = True
oRng.HighlightColorIndex = wdYellow
oRng.Collapse wdCollapseEnd
strThisWord = arrWords(i) & " (" & lngCount & ")"
lngCount = lngCount + 1
Wend
If bList Then
If Len(strRestricted) = 0 Then
strRestricted = strThisWord
Else
strRestricted = strRestricted & ", " & strThisWord
End If
End If
Next

End With
Set oRng = Nothing
If Len(strRestricted) > 0 Then
MsgBox "You have used the following restricted word or words in your document: " & strRestricted & vbCr + vbCr _
& "Please review and redact the restricted words before attempting to save this document."
Exit Sub
Else
ActiveDocument.Save
End If
End Sub


Good morning,

I am using the following code (thanks to this forum)

Sub FileSave()
'
'Sub Demo()
Dim oRng As Range, arrWords, i As Long, HiLite As Variant
Set oRng = ActiveDocument.Range
With oRng.Find
arrWords = Array("abet", "abscond", "abuse", "amphetamine", "arson", "armed", "asbo", "assault", "bail", "bigamy", "blackmail", "bomb", "bribe", "brothel")
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = False
.Replacement.Text = "^&"
.Replacement.Highlight = True
HiLite = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdYellow
For i = 0 To UBound(arrWords)
.Text = arrWords(i)
.Execute Replace:=wdReplaceAll
While .Execute(Replace:=wdReplaceOne)
oRng.Collapse wdCollapseEnd
MsgBox "You have used a restricted word, please check your document: " & arrWords(i)
Wend
Next
Options.DefaultHighlightColorIndex = HiLite
End With
Set oRng = Nothing
ActiveDocument.Save
End Sub



To look for certain words used within a document, can someone educate me as to how to make this work when the document is protected? Currently if it is you get a 4605 error - this command is not available " .Execute Replace:=wdReplaceAll"

I have a spellcheck macro that works with a protected doc so looking at that it appears to be something to do with

oDoc.Unprotect Password:=""
and
Select Case oDoc.ProtectionType

but I can't make it work :(