Trying to create a word macro to emulate a program called e-cleaner

S

somebody

I have been trying in vain to write a Word 2003 macro that would
emulate the actions of a little program called e-cleaner. The program
can be found at http://ecleaner.tripod.com/clean202.zip. It is
freeware and very small in size. The program removes unwanted
characters from a document. You can choose the characters you want to
remove. After it has removed all unwanted characters it reformats the
page to remove all redundant spaces, leaving you with a nicely cleaned
and formatted document.
The problem is that you have to copy and paste the info into e-cleaner
before it can clean the document. then you have to cut from ecleaner
and paste into whatever document you want the cleaned text in.
I am a real newbie at this but have spent hours trying to figure it
out. I have made some progress and have a macro that will remove the
characters of my choice but it doesn't remove the spaces left behind
after removing the characters. Unfortunately my macro is long and very
redundant in the code (see macro below). I have asked about this
before in this forum and received some help but their suggestions
didn't really help. If you have the time to help me write this, I
would really appreciate it. Remember I am a newbie but I am trying
hard to learn. Thanks in advance. Joe

_____________________________________________________________________________________________________


Sub Macro1()
'
' Macro1 Macro
' Macro recorded 8/14/2005 by Joe
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "+"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "/"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ">"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "<"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ")"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "("
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "?"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "*"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "%"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "#"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "$"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "="
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "\"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "/"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "-"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ";"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = ":"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
 
J

Jonathan West

Hi Joe

This is the key bit of code

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "+"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll


What you need is to be able to replace the "+" with a different character
and repeat the find each time round. This can be done as follows

Sub EasyClean()
Dim sClean As String
Dim i As Long

'Input the list of characters to be cleaned
sClean = InputBox("Type in the characters you want cleaned")
If Len(sClean) = 0 Then Exit Sub

'Start setting up the find object
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

'Set the Find text to be each character of the string in turn
For i = 1 To Len(sClean)

'Special rule for the caret character - needs to be doubled
If Mid$(sClean, i, 1) = "^" Then
.Text = "^^"
Else
.Text = Mid$(sClean, i, 1)
End If
.Execute Replace:=wdReplaceAll
Next i

'Set find & replace text so that multiple spaces are replaced by single
spaces
.Text = "^w"
.Replacement.Text = " "
.Execute Replace:=wdReplaceAll

End With
End Sub

--
Regards
Jonathan West - Word MVP
www.intelligentdocuments.co.uk
Please reply to the newsgroup
Keep your VBA code safe, sign the ClassicVB petition www.classicvb.org
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top