CHAR PROBLEM - MACRO WORKS FOR 2002 BUT NOT 2003

[Kathryn]

I've found a macro off another Help Site that is meant to help with removing
the 'char' problem. Apparently the macro works for Word 2002 but not for
Word 2003. Can anyone help convert the macro below to a 2003 version.
Thanks for your help : -)

Sub DeleteCharCharStylesKeepFormatting( )
Dim sty As Style
Dim i As Integer
Dim doc As Document
Dim sStyleName As String
Dim sStyleReName As String
Dim bCharCharFound As Boolean

Set doc = ActiveDocument
Do

bCharCharFound = False
For i = doc.Styles.Count To 1 Step -1
Set sty = doc.Styles(i)
sStyleName = sty.NameLocal
If sStyleName Like "* Char*" Then

bCharCharFound = True
If sty.Type = wdStyleTypeCharacter Then
Call StripStyleKeepFormatting(sty, doc)
On Error Resume Next
'#############################################
' COMMENT OUT THE NEXT LINE IN WORD 2000 OR 97
sty.LinkStyle = wdStyleNormal
sty.Delete
Err.Clear
Else
sStyleReName = Replace(sStyleName, " Char", "")
On Error Resume Next
sty.NameLocal = sStyleReName
If Err.Number = 5173 Then
Call SwapStyles(sty, doc.Styles(sStyleReName), doc)
sty.Delete
Err.Clear
Else
On Error GoTo ERR_HANDLER
End If
End If
Exit For
End If
Set sty = Nothing
Next i
Loop While bCharCharFound = True
Exit Sub
ERR_HANDLER:
MsgBox "An Error has occurred" & vbCr & _
Err.Number & Chr(58) & Chr(32) & Err.Description, _
vbExclamation
End Sub

Function SwapStyles(ByRef styFind As Style, _
ByRef styReplace As Style, _
ByRef doc As Document)
With doc.Range.Find
.ClearFormatting
.Text = ""
.Wrap = wdFindContinue
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Style = styFind
.Replacement.ClearFormatting
.Replacement.Style = styReplace
.Replacement.Text = "^&"
.Execute Replace:=wdReplaceAll
End With
End Function


Function StripStyleKeepFormatting(ByRef sty As Style, _
ByRef doc As Document)
Dim rngToSearch As Range
Dim rngResult As Range
Dim f As Font

Set rngToSearch = doc.Range
Set rngResult = rngToSearch.Duplicate

Do
With rngResult.Find
.ClearFormatting
.Style = sty
.Text = ""
.Forward = True
.Wrap = wdFindStop
.Execute
End With

If Not rngResult.Find.Found Then Exit Do

Set f = rngResult.Font.Duplicate
With rngResult
.Font.Reset
.Font = f
.MoveStart wdWord
.End = rngToSearch.End
End With
Set f = Nothing
Loop Until Not rngResult.Find.Found
End Function