Solved

Erasing whole line via VBScript doesn't work

Posted on 2014-02-26
9
716 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 53

Assisted Solution

by:Bill Prew
Bill Prew earned 100 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 76

Assisted Solution

by:GrahamSkan
GrahamSkan earned 400 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 24

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
Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

 
LVL 76

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 24

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 24

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 76

Assisted Solution

by:GrahamSkan
GrahamSkan earned 400 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 24

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 24

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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Introduction This tutorial provides instructions on how to properly format your Word document using the inbuilt tools provided. The benefits of using these tools means your documents are more accessible and easily portable to other applications an…
Microsoft Word is a program we have all encountered at some point, but very few of us have dug deep into its full scope of features, let alone customized it to suit our needs. Luckily making the ribbon (aka toolbar, first introduced in Word 2007) wo…
This video teaches the viewer how to align pictures around text while keeping the text properly aligned in the document.
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.

816 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now