Remove Trailing blank spaces in endnotes / footnotes in word docum

[Sita]

Hi,

We are having an issue while processing endnotes/footnotes in a word
document to remove any extra spaces (trailing) at the end of each endnote /
footnote.

We are using following piece of code to replace trailing spaces in the
endnote. Although there are no trailing spaces in the endnote,
allText.Find.Execute is returning true and its not coming out of the while
loop for the end note processing.

Also, even if i open the word document search for " ^p" in endnotes and try
to replace, it does not let me do that.

Const wdReplaceAll = 2
Const wdFindContinue = 1
For Each en In objDoc.EndNotes
allText = en.Range
If allText.Find.Execute (" ^p", False, False, False, False, False, True,
wdFindContinue, False, "^p", wdReplaceAll) = True Then
isReturn = True
End If

Really appreciate your help.

Thanks,
Sita

 

[David Sisson]

Sub TrimEndnotes()
Dim aDoc As Document
Dim Rng As Range
Dim NumEN As Integer

Set aDoc = ActiveDocument
NumEN = ActiveDocument.Endnotes.Count

For A = NumEN To 1 Step -1
Set Rng = aDoc.Endnotes(A).Range
Rng = RTrim(Rng)
Next A

End Sub

Sub TrimFootNotes()
Dim aDoc As Document
Dim Rng As Range
Dim NumEN As Integer

Set aDoc = ActiveDocument
NumEN = ActiveDocument.Footnotes.Count

For A = NumEN To 1 Step -1
Set Rng = aDoc.Footnotes(A).Range
Rng = RTrim(Rng)
Next A

 

[Sita]

Thanks David for the solution. The given code has removed trailing blank
spaces in the foot / end notes.

But trailing tab spaces still exist. Do we need to handle trailing tab
spaces separately? If so, any suggestions?

 

[David Sisson]

But trailing tab spaces still exist. Do we need to handle trailing tab

spaces separately? If so, any suggestions?

This seems to work and covers multiple tabs in one endnote.

Replace Endnotes with Footnotes to correct those as well.

Sub TrailingTabs()
Dim aDoc As Document
Dim Rng As Range
Dim NumEN As Integer
Dim A As Integer

Set aDoc = ActiveDocument
NumEN = ActiveDocument.Endnotes.Count

For A = NumEN To 1 Step -1
Set Rng = aDoc.Endnotes(A).Range
Do
With Rng.Find
.Text = Chr(9) & Chr(13)
.Replacement.Text = Chr(13)
.Forward = True
.Wrap = wdFindContinue
End With
Rng.Find.Execute Replace:=wdReplaceAll
Loop Until Rng.Find.Found = False
Next A

End Sub

 

[Sita]

Below code is giving compilation error as i am using Office 2003

So, I have tried with a different code (below), although it doesnt replace
anything but it returns true.

Dim allText, isReturn
Set allText = en.Range
allText.Find.Replacement.ClearFormatting
If allText.Find.Execute (ChrW(9) & ChrW(13), False, False, False, False,
False, True, wdFindContinue, False, ChrW(13), wdReplaceAll) = True Then
isReturn = True
End If

any suggestions?

 

[David Sisson]

Below code is giving compilation error as i am using Office 2003

So, I have tried with a different code (below), although it doesnt replace
anything but it returns true.

Dim allText, isReturn
Set allText = en.Range
allText.Find.Replacement.ClearFormatting
If allText.Find.Execute (ChrW(9) & ChrW(13), False, False, False, False,
False, True, wdFindContinue, False, ChrW(13), wdReplaceAll) = True Then
isReturn = True
End If

any suggestions?

Based on what you've posted, en isn't defined, hence, allText can't be
defined.

It would help if you posted the error and which line is highlighted.

If you just need to set isReturn when found, put in the following line
in my last code.

 

[Sita]

Hi David,

Following is total piece of code i am trying to run on word document.

Const wdFormatDocument = 0
Const wdReplaceAll = 2
Const wdFindContinue = 1


Dim objWord ,objDoc, docFile

docFile = docFile = WScript.Arguments( 0 )
Call processEndNotes

Sub processEndNotes
dim foundSpaces
dim en
On Error Resume Next

Set objWord = CreateObject("Word.Application")
objWord.Visible = False
Set objDoc = objWord.Documents.Open (docFile)

WScript.Echo "processing endnotes.."
For Each en In objDoc.EndNotes
WScript.Echo "processEndNotes() : en : " & en.index
foundSpaces = executeRemoveSpaces(en.Range)
Do While foundSpaces
foundSpaces = executeRemoveSpaces(en.Range)
Loop
en.Range = RTrim(en.Range)
trailingTabs(en.Range)
Next


objDoc.SaveAs docFile, , wdFormatDocument

objDoc.Close
Set objDoc = Nothing
objWord.Quit
Set objWord = Nothing

If Err.Number <> 0 Then
WScript.echo "Removing spaces/tabs was not successful"
WScript.echo "ERROR:Number=" & Err.Number
WScript.echo "ERRORescription=" & Err.Description
Err.Clear
closeDoc
Wscript.Quit 0
End If

End Sub

Function trailingTabs(range)
Do
With range.Find
.Text = Chr(9) & Chr(13)
.Replacement.Text = Chr(13)
.Forward = True
.Wrap = wdFindContinue
End With
range.Find.Execute Replace = wdReplaceAll
Loop Until range.Find.Found = False
End Function

Function executeRemoveSpaces(range)
dim allText, isReturn
Set allText = range
allText.Find.Replacement.ClearFormatting
isReturn = allText.Find.Execute (" ", False, False, False, False,
False, True, wdFindContinue, False, " ", wdReplaceAll)
executeRemoveSpaces = isReturn
Set allText = Nothing
End Function


_________________________________________

Following compilation error message is showing while trying to run.

C:\WKCode\Workspace\webtop-ltbna\scripts\processEndNotes2.vbs(57, 29)
Microsoft VBScript compilation error: Expected statement

line # 57 is "range.Find.Execute Replace:=wdReplaceAll"

position # 29 is ":"

I have removed : (colon) and tried to run, it gave following error message :

Microsoft (R) Windows Script Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

processing endnotes..
Removing items was not successful
ERROR:Number=424
ERRORescription=Object required

***** script completed *****

 

[David Sisson]

I am not familier with running from WScript, but Range is a reserve
word in Word.

foundSpaces = executeRemoveSpaces(en.Range)

would be correct, but...

Function trailingTabs(range)
        Do
        With range.Find
                .Text = Chr(9) & Chr(13)
                .Replacement.Text = Chr(13)
                .Forward = True
                .Wrap = wdFindContinue
        End With
        range.Find.Execute Replace  = wdReplaceAll
        Loop Until range.Find.Found = False
End Function

Might cause trouble.

Try
Function trailingTabs(Rng)
Do
With Rng.Find
.Text = Chr(9) & Chr(13)
.Replacement.Text = Chr(13)
.Forward = True
.Wrap = wdFindContinue
End With
Rng.Find.Execute Replace = wdReplaceAll
Loop Until Rng.Find.Found = False
End Function

Anyone else have a suggestion?

 

[Helmut Weber]

Hi everybody,

see: http://tinyurl.com/2885um

Somewhat adapted to endnotes:

Sub Macro3ab()
Dim rDcm As Range
Dim rPrg As Paragraph
Dim rEnd As Endnote
Set rDcm = ActiveDocument.Range
' not to mention sections
' could be processed as well
For Each rEnd In rDcm.Endnotes
For Each rPrg In rEnd.Range.Paragraphs
With rPrg.Range.Characters
While .Last.Previous = Chr(32) _
Or .Last.Previous = Chr(9)
.Last.Previous = ""
Wend
End With
Next
Next
End Sub

Don't delete anything, because of possible autocorrection issues.
And don't replace a paragraph mark by chr(13),
because this might ruin formatting and replace
a paragraph mark by a pure chr(13).

In addition, there a some kinds of spaces
ordinary ascW(32)
non-breaking ascW(160)
em-space ascW(8195)
en-space ascW(8194)
¼-em-space ascW(8197)