Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Erasing whole line via VBScript doesn't work

Posted on 2014-02-26
9
Medium Priority
?
770 Views
Last Modified: 2014-03-04
Hi,

I'm trying to erase a line of text, including the end-of-paragraph mark. When I manually do it in Word, it works fine - in vbscript, it doesn't. It enters the .Execute statement and each line w/o error. But nothing happens to the text.

In the debugger, the find and replace variables look fine.
strFindText = "erase this paragraph^p"
strReplacementText = ""


Any ideas?

I'm running the script in XP SP3.

Const TIMEOUT_1_SEC = 1
Const POPUP_TITLE = "Find and Replace"

Dim objShell 'As IWshRuntimeLibrary.WshShell
Dim objDoc 'As Word.Document
Dim objWord 'As Word.Application
Dim objRangeFind 'As Word.Find

Set objShell = CreateObject("WScript.Shell")

Sub FindNRepl
	sFilename = "C:\Local\test2.doc"
	
	Set objDoc = objWord.Documents.Open(sFilename)
	strFindText = "erase this paragraph^p"
	strReplacementText = ""
	Do While Not IsEmpty(strFindText)
		Set objRangeFind = objDoc.Range.Find
		objRangeFind.ClearFormatting
		objRangeFind.Replacement.ClearFormatting
		With objRangeFind
			.Text = strFindText
			.Replacement.Text = strReplacementText
			.Forward = True
			.Wrap = wdFindContinue
			.Format = False
			.MatchCase = True
			.MatchWholeWord = False
			.MatchWildcards = False
			.MatchSoundsLike = False
			.MatchAllWordForms = False
			.Replacement.Font.Color = vbMagenta
			If .Execute Then
				objShell.Popup "Replacing text...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
				objRangeFind.Execute, , , , , , , , , ,wdReplaceAll
				objShell.Popup "Replacement done.", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
				If objDoc.Saved = False Then
					objDoc.Save
				End If
			Else
				objShell.Popup "Not found...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
			End If
		End With
		' Get next find and replace strings
		'nRecFind = nRecFind + 1
		'strFindText = aStrs(nRecFind,0)
		'strReplacementText = aStrs(nRecFind,1)
	Loop 'While Not IsEmpty(strFindText)
End Sub

Open in new window



Chris
0
Comment
Question by:NVIT
  • 5
  • 3
9 Comments
 
LVL 59

Assisted Solution

by:Bill Prew
Bill Prew earned 400 total points
ID: 39890161
Is this the entire script?  If so then there are some problems before I even get to the replace logic.  The subroutine is not called.  And in the subroutine you reference objWord, but that variable is never set to an object...

~bp
0
 
LVL 77

Assisted Solution

by:GrahamSkan
GrahamSkan earned 1600 total points
ID: 39890163
There is a lot of extra unnecessary code here, and it is hard to understand how the loop is ever to end, since strFindText is does not get changed.
I would start with this:
Sub FindNRep2()
    sFilename = "C:\Local\test2.doc"
    
    Set objDoc = objWord.Documents.Open(sFilename)
    strFindText = "erase this paragraph^p"
    strReplacementText = ""
    
    With objDoc.Range.Find
        .Text = strFindText
        .Replacement.Text = strReplacementText
        If .Execute Then
            objShell.Popup "Replacing text...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
            objRangeFind.Execute , , , , , , , , , , wdReplaceAll
            objShell.Popup "Replacement done.", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
            If objDoc.Saved = False Then
                objDoc.Save
            End If
        Else
            objShell.Popup "Not found...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
        End If
    End With
End Sub

Open in new window

0
 
LVL 26

Author Comment

by:NVIT
ID: 39890245
Sorry, all. Here's a code repost.

BTW, how can I see the result of the "objRangeFind.Execute, , , , , , , , , ,wdReplaceAll" line?

Const TIMEOUT_1_SEC = 1
Const POPUP_TITLE = "Find and Replace"

Dim objShell 'As IWshRuntimeLibrary.WshShell
Dim objDoc 'As Word.Document
Dim objWord 'As Word.Application
Dim objRangeFind 'As Word.Find

Set objShell = CreateObject("WScript.Shell")

FindNRepl

Sub FindNRepl
	sFilename = "C:\Local\test2.doc"
	Set objWord = CreateObject("Word.Application")
	objWord.Visible = True 'make sure that you can see instances of Application
	Set objDoc = objWord.Documents.Open(sFilename)
	strFindText = "erase this paragraph^p"
	strReplacementText = ""
	Do While Not IsEmpty(strFindText)
		Set objRangeFind = objDoc.Range.Find
		objRangeFind.ClearFormatting
		objRangeFind.Replacement.ClearFormatting
		With objRangeFind
			.Text = strFindText
			.Replacement.Text = strReplacementText
			If .Execute Then
				objShell.Popup "Replacing text...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
				objRangeFind.Execute, , , , , , , , , ,wdReplaceAll
				objShell.Popup "Replacement done.", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
				If objDoc.Saved = False Then
					objDoc.Save
				End If
			Else
				objShell.Popup "Not found...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
			End If
		End With
		strFindText = emptyvar
	Loop 'While Not IsEmpty(strFindText)
	CloseWordAppAndQuit
End Sub

'-------------------------------------------------------------------------------
' CloseWordAppAndQuit
'-------------------------------------------------------------------------------
sub CloseWordAppAndQuit
	objWord.NormalTemplate.Saved = True 'so the dialog doesn't ask if we want to save the NORMAL.DOT template.
	objWord.Quit
	WScript.Quit
end sub

Open in new window

0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 77

Expert Comment

by:GrahamSkan
ID: 39890321
Not too sure where you are stuck, but here is an (untested) suggestion.
After a successful find, the input Range object is set to the the found range, so here you can simply delete the first paragraph. Note that I use the VBA editor to create this, so I might have left some VBA-only syntax.
'Sub FR()
Const TIMEOUT_1_SEC = 1
Const POPUP_TITLE = "Find and Replace"

Dim objShell 'As IWshRuntimeLibrary.WshShell
Dim objDoc 'As Word.Document
Dim objWord 'As Word.Application
Dim objRangeFind 'As Word.Find
Dim rng          ' As Range

Set objShell = CreateObject("WScript.Shell")

FindNRepl

Sub FindNRepl()
    sFilename = "C:\Local\test2.doc"
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True 'make sure that you can see instances of Application
    Set objDoc = objWord.Documents.Open(sFilename)
    strFindText = "erase this paragraph^p"
    strReplacementText = ""
    Do While Not IsEmpty(strFindText)
        Set rng = objDoc.Range
        Set objRangeFind = rng.Find
        With objRangeFind
            .Text = strFindText
            .Replacement.Text = strReplacementText
            If .Execute Then
                rng.Paragraphs.First.Delete
                objShell.Popup "Replacing text...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
                objRangeFind.Execute , , , , , , , , , , wdReplaceAll
                objShell.Popup "Replacement done.", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
                If objDoc.Saved = False Then
                    objDoc.Save
                End If
            Else
                objShell.Popup "Not found...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
            End If
        End With
        strFindText = emptyvar
    Loop 'While Not IsEmpty(strFindText)
    CloseWordAppAndQuit
'End Sub

Open in new window

0
 
LVL 26

Author Comment

by:NVIT
ID: 39890367
Hi Graham,

I haven't tried your solution yet.

Mine is basically a find and replace tool which works fine until now I have to erase the entire line, i.e. paragraph. Some documents have single-line text such as titles. If I just use "erase this paragraph", it leaves the blank line. So, I added the ^p at the end. It works fine manually in Word but not in this macro.

Again, I haven't had a chance to try your solution yet. At face value, it seems to ALWAYS delete the text. Would it still work with general find and replace?
0
 
LVL 26

Author Comment

by:NVIT
ID: 39890715
In the Find dialog, I enter: erase this paragraph^p
In the Replace dialog, I enter: ^p

This results in a blank line, as expected.

Rewind and try this...

In the Find dialog, I enter: erase this paragraph^p
In the Replace dialog, I don't enter any text. Just pick OK.

It doesn't erase the text and ^p mark, as I'd expect. As I said in my OP, it enters the statement but nothing happens.

Rewind and try this...

In the Find dialog, I enter: erase this paragraph^p
In the Replace dialog, I enter a single SPACE character.

This results erasing the line and ^p mark. But, the next line is now prefixed with a space character. Although it's not obvious to the eye, this is not the proper way to do it.

Any suggestions?
0
 
LVL 77

Assisted Solution

by:GrahamSkan
GrahamSkan earned 1600 total points
ID: 39891899
Here is a tested VBScript:
'Sub FR()
Const TIMEOUT_1_SEC = 1
Const POPUP_TITLE = "Find and Replace"

Dim objShell 'As IWshRuntimeLibrary.WshShell
Dim objDoc 'As Word.Document
Dim objWord 'As Word.Application
Dim objRangeFind 'As Word.Find
Dim rng          ' As Range

Set objShell = CreateObject("WScript.Shell")

FindNRepl

Sub FindNRepl()
    sFilename = "C:\Local\test2.doc"
    Set objWord = CreateObject("Word.Application")
    objWord.Visible = True 'make sure that you can see instances of Application
    Set objDoc = objWord.Documents.Open(sFilename)
    strFindText = "erase this paragraph^p"
    strReplacementText = ""
    Do While Not IsEmpty(strFindText)
        Set rng = objDoc.Range
         With rng.Find
            .Text = strFindText
            .Replacement.Text = strReplacementText
            If .Execute Then
                rng.Paragraphs.First.Range.Delete
                'objShell.Popup "Replacing text...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
                'objRangeFind.Execute , , , , , , , , , , wdReplaceAll
                'objShell.Popup "Replacement done.", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
                If objDoc.Saved = False Then
                    objDoc.Save
                End If
            Else
                objShell.Popup "Not found...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
            End If
        End With
        strFindText = emptyvar
    Loop 'While Not IsEmpty(strFindText)
    CloseWordAppAndQuit
End Sub

'-------------------------------------------------------------------------------
' CloseWordAppAndQuit
'-------------------------------------------------------------------------------
sub CloseWordAppAndQuit
	objWord.NormalTemplate.Saved = True 'so the dialog doesn't ask if we want to save the NORMAL.DOT 

template.
	objWord.Quit
	WScript.Quit
end sub     

Open in new window

0
 
LVL 26

Accepted Solution

by:
NVIT earned 0 total points
ID: 39893212
Here's the final code. It now lets me replace or delete text. In the end, I didn't use your "rng.Paragraphs.First.Range.Delete". Instead, it was a matter of knowing more how the Find object works. Still, since you guys helped me get there, I'll split the points:

Const wdReplaceAll = 2
Const POPUP_TITLE = "Find and Replace"
Const TIMEOUT_1_SEC = 1

Dim objShell 'As IWshRuntimeLibrary.WshShell
Dim objDoc 'As Word.Document
Dim objWord 'As Word.Application
Dim objRangeFind 'As Word.Find

Set objShell = CreateObject("WScript.Shell")

FindNRepl

Sub FindNRepl()
	sFilename = "c:\local\FindNRepl.doc"
	Set objWord = CreateObject("Word.Application")
	objWord.Visible = True 'make sure that you can see instances of Application
	Set objDoc = objWord.Documents.Open(sFilename)
	strFindText = "Erase this paragraph^p"
	strReplacementText = ""
	Do While Not IsEmpty(strFindText)
    Set rng = objDoc.Range
    With rng.Find
			.Text = strFindText
			.Replacement.Text = strReplacementText
      .Wrap = wdFindContinue
			If strReplacementText <> "" Then
				objShell.Popup "Replacing text...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
				.Execute , , , , , , , , , , wdReplaceAll
			Else
				objShell.Popup "Erasing text...", TIMEOUT_1_SEC, POPUP_TITLE, vbInformation + vbOKOnly
				.Execute , , , , , , , , , , wdReplaceAll
			End If
			If objDoc.Saved = False Then
				objDoc.Save
			End If
		End With
		strFindText = emptyvar
	Loop 'While Not IsEmpty(strFindText)
	CloseWordAppAndQuit
End Sub

'-------------------------------------------------------------------------------
' CloseWordAppAndQuit
'-------------------------------------------------------------------------------
sub CloseWordAppAndQuit
	objWord.NormalTemplate.Saved = True 'so the dialog doesn't ask if we want to save the NORMAL.DOT template.
	objWord.Quit
	WScript.Quit
end sub

Open in new window

0
 
LVL 26

Author Closing Comment

by:NVIT
ID: 39902811
Here's the final code. It now lets me replace or delete text. In the end, I didn't use Graham's "rng.Paragraphs.First.Range.Delete". Instead, it was a matter of knowing more how the Find object works and revising accordingly.
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
This is written from a 'VBA for MS Word' perspective, but I am sure it applies to most other MS Office components where VBA is used.  One thing that really bugs me is slow code, ESPECIALLY when it's mine!  In programming there are so many ways to…
This video teaches the viewer how to align pictures around text while keeping the text properly aligned in the document.
This video walks the viewer through the process of creating envelopes and labels, with multiple names and addresses. Navigate to the “Start Mail Merge” button in the Mailings tab: Follow the step-by-step process until asked to find the address doc…
Suggested Courses

564 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question