MS word - macro - text replacement

[Tom1212]

Hi,
I have to create a macro for replacing a text in a MS word document by a text.
The target position of new text is defined by used style, so I just know the name of the style and the new text.
My Code:

Sub OpenDocuments()
Dim wrd1App As Word.Application
Dim target As Word.Document
On Error GoTo Exit_Proc
Set wrd1App = CreateObject("Word.Application")

Set target = wrd1App.Documents.Open("C:\Documents and Settings\user\My Documents\target.dotx")
Call SetProtection(target)

On Error GoTo Exit_Proc

Call FindAndReplaceFirstStoryOfEachType(target)

Exit_Proc:
wrd1App.Quit False
Set wrd1App = Nothing

wrd2App.Quit False
Set wrd2App = Nothing

MsgBox "Unexpected error. Type: " & Err.Description & Err.Number


End Sub

Sub FindAndReplaceFirstStoryOfEachType(source As Word.Document, target As Word.Document)

Dim newStr As String
newStr = "NEW STRING"

Dim rngStory As Range
Set rngStory = target.Range
Call replII("Candidate name", newStr, rngStory) 'This procedure does not make any text replacement!!!!

With rngStory.Find

.Replacement.Text = newStr
.Wrap = wdFindStop
.Forward = True
.Style = target.Styles("Candidate name")
.Execute 'Replace:=wdReplaceAll

End With
Call repIII("Candidate name", newStr, rngStory) 'This procedure does not make any text replacement!!!!

rngStory.Text = newStr 'Here I get error: 6124: you are not allowed to edit this selection because it is protected
Dim testStr As String
testStr = rngStory.Text

End Sub


Sub replII(ByVal sFindStyle As String, ByVal sReplaceText As String, ByRef rangeDocument As Range)
With rangeDocument.Find
.ClearFormatting
.Style = sFindStyle
.Replacement.ClearFormatting
.Replacement.Text = sReplaceText
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With


End Sub
Sub repIII(ByVal sFindStyle As String, ByVal sReplaceText As String, ByRef rangeDocument As Range)
With rangeDocument
.Select
Selection.Collapse wdCollapseStart
Selection.TypeText sReplaceText '--CAPSID is an array that stores
End With
End Sub

Sub SetProtection(ByRef doc As Document)
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect Password:="12345"

End If
End Sub

Please, could anyone explain me why rngStory.Text = newStr returns the error 6124 and why procedures replII and repIII do not make any text replacement in target MS Word document.
Thank you very much for your advice.

Edit : ADDED CODE TAGS Tommy

[Frosty]

It helps if you use the VBA button or tags to make your code more readable. By my reading, this code will not compile. You also need to use Option Explicit at the top of any code modules, and then try to compile your project. This is critical in all coding, but especially so when you are creating instances of applications using CreateObject.

You are opening a document ("target" variable) and then passing that in as your "source" parameter to a subroutine, but then within that subroutine you reference your "target" parameter-- which doesn't have anything in it.

Where are you calling this code from? Why do you need to create the Word application?


Sub OpenDocuments()
Dim wrd1App As Word.Application
Dim target As Word.Document
On Error GoTo Exit_Proc
Set wrd1App = CreateObject("Word.Application")

Set target = wrd1App.Documents.Open("C:\Documents and Settings\user\My Documents\target.dotx")
Call SetProtection(target)

On Error GoTo Exit_Proc

Call FindAndReplaceFirstStoryOfEachType(target)

Exit_Proc:
wrd1App.Quit False
Set wrd1App = Nothing

wrd2App.Quit False
Set wrd2App = Nothing

MsgBox "Unexpected error. Type: " & Err.Description & Err.Number


End Sub

Sub FindAndReplaceFirstStoryOfEachType(source As Word.Document, target As Word.Document)

Dim newStr As String
newStr = "NEW STRING"

Dim rngStory As Range
Set rngStory = target.Range
Call replII("Candidate name", newStr, rngStory) 'This procedure does not make any text replacement!!!!

With rngStory.Find

.Replacement.Text = newStr
.Wrap = wdFindStop
.Forward = True
.Style = target.Styles("Candidate name")
.Execute 'Replace:=wdReplaceAll

End With
Call repIII("Candidate name", newStr, rngStory) 'This procedure does not make any text replacement!!!!

rngStory.Text = newStr 'Here I get error: 6124: you are not allowed to edit this selection because it is protected
Dim testStr As String
testStr = rngStory.Text

End Sub


Sub replII(ByVal sFindStyle As String, ByVal sReplaceText As String, ByRef rangeDocument As Range)
With rangeDocument.Find
.ClearFormatting
.Style = sFindStyle
.Replacement.ClearFormatting
.Replacement.Text = sReplaceText
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With


End Sub
Sub repIII(ByVal sFindStyle As String, ByVal sReplaceText As String, ByRef rangeDocument As Range)
With rangeDocument
.Select
Selection.Collapse wdCollapseStart
Selection.TypeText sReplaceText '--CAPSID is an array that stores
End With
End Sub

Sub SetProtection(ByRef doc As Document)
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect Password:="12345"

End If
End Sub

[macropod]

Cross-posted at: http://social.msdn.microsoft.com/Forums/en-US/worddev/thread/f9bad92c-28e4-4767-ac4e-d22f9c6bc8b4
For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184 (http://www.excelguru.ca/content.php?184)

I, for one, don't like finding that I've been wasting my time retracing issues that may have been dealt with elsewhere.

Frosty: I've covered some of the same ground in the other forum, plus a bunch of other issues as well.

[Frosty]

You gave a more thorough analysis in your post, Paul. ;)

Thanks for policing the cross-post. I think I need to simply add this to my signature.

[Tom1212]

Thank you for your responses. I am sorry for the cross-post. I followed your advice, unfortunately it does not work. Still no change in the target document and still get error 6124 (returned by command: rngStory.InsertAfter str)

My changed macro:


Sub OpenDocuments()
Dim wrd1App As Word.Application
Dim wrd2App As Word.Application
Dim source As Word.Document
Dim target As Word.Document
On Error GoTo Exit_Proc
Set wrd1App = CreateObject("Word.Application")
Set wrd2App = CreateObject("Word.Application")

Set target = wrd1App.Documents.Open("C:\Documents and Settings\user\My Documents\target.dotx")
Call SetProtection(target)


Set source = wrd2App.Documents.Open("C:\Documents and Settings\user\My Documents\source.docx")

On Error GoTo Exit_Proc

Call FindAndReplaceFirstStoryOfEachType(source, target)

Exit_Proc:
wrd1App.Quit False
Set wrd1App = Nothing

wrd2App.Quit False
Set wrd2App = Nothing

MsgBox "Unexpected error. Type: " & Err.Description & Err.Number


End Sub

Sub FindAndReplaceFirstStoryOfEachType(source As Word.Document, target As Word.Document)

Dim r As Range
Set r = source.Range
With r.Find
.Style = source.Styles("CV name")
.Forward = True
.Wrap = wdFindStop
.Execute

End With

Dim str As String
str = r.Text

Dim rngStory As Range
Set rngStory = target.Range
Call replII("Candidate name", str, rngStory)

With rngStory.Find

.Replacement.Text = r.Text
.ClearFormatting
.Replacement.ClearFormatting
.Wrap = wdFindStop
.Forward = True
.Text = ""
.Style = target.Styles("Candidate name")
.Execute 'Replace:=wdReplaceAll

End With
Call repIII("Candidate name", str, rngStory)
rngStory.InsertAfter str
'rngStory.Text = str
Dim testStr As String
testStr = rngStory.Text

End Sub



Sub replII(ByVal sFindStyle As String, ByVal sReplaceText As String, ByRef rangeDocument As Range)
With rangeDocument.Find
.ClearFormatting
.Style = sFindStyle
.Text = ""
.Replacement.ClearFormatting
.Replacement.Text = sReplaceText
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With


End Sub
Sub repIII(ByVal sFindStyle As String, ByVal sReplaceText As String, ByRef rangeDocument As Range)
With rangeDocument
.Select
Selection.Collapse wdCollapseStart
Selection.TypeText sReplaceText '--CAPSID is an array that stores
End With
End Sub

Sub SetProtection(ByRef doc As Document)
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect Password:="12345"

End If
End Sub

[Frosty]

You need to answer the rest of my questions... why are you creating separate application processes for the purpose of opening a single document? Where are you calling this code from (if you are already in Word, you do not need to use CreateObject *at all*).

No point in troubleshooting what's wrong when I don't know why you're using the structure you currently have. It would also be useful for you to go with Macropod's responses in the other thread-- he gave a good bit of helpful advice there too, not all of which you seem to have followed.

I wouldn't post any more code without explaining what you're trying to do... because I think you're making this far more difficult than it needs to be.

Don't forget to use your VBA tags, please.

[Frosty]

Or rather, to sum up... you want to
1. Look for a style ("CV Name") in your source document, and whatever the text of that style is...
2. You want to replace all instances of the style "Candidate Name" in the target document with the text contained in "CV Name" in the original document.

This is a cleaned up version of your code...

What isn't working?

Sub OpenDocuments()
Dim source As Word.Document
Dim target As Word.Document

On Error GoTo l_err

Set target = Application.Documents.Open("C:\Documents and Settings\user\My Documents\target.dotx")
Set source = Application.Documents.Open("C:\Documents and Settings\user\My Documents\source.docx")

'unprotect if necessary
If target.ProtectionType <> wdNoProtection Then
target.Unprotect Password:="12345"
End If

Call FindAndReplace(source, target)

l_exit:
On Error Resume Next
target.Saved = True
target.Close
Exit Sub

l_err:
MsgBox "Unexpected error. Type: " & Err.Description & Err.Number
Resume l_exit
End Sub

Sub FindAndReplace(source As Word.Document, target As Word.Document)

Dim r As Range
Dim str As String
Dim rngStory As Range
Dim testStr As String

Set r = source.Range
With r.Find
.Style = source.Styles("CV name")
.Forward = True
.Wrap = wdFindStop
.Execute
End With

str = r.Text

Set rngStory = target.Range
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = str
.Style = "Candidate name"
.Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
End With

With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = str
.Wrap = wdFindStop
.Forward = True
.Style = "Candidate name"
.Execute 'Replace:=wdReplaceAll <-- why is this commented out? what do you want to have happen here?
End With

'why do you need to use selection here?
With rngStory
.Select
Selection.Collapse wdCollapseStart
Selection.TypeText str '--CAPSID is an array that stores
End With

rngStory.InsertAfter str
'rngStory.Text = str
testStr = rngStory.Text

End Sub

[Frosty]

It would be great if you could take the above code, and work to name it appropriately to what you want to have happen. Or describe in a very detailed manner the steps by which you want to do what it appears you're doing.

1. Open two documents (source and target), unprotected source doc as necessary
2. Get the text of the first found style named CV Name in source
3. Replace any text styled Candidate Name in the target document with the text found in #2
4. Put the text of #2 at the very beginning of the target document

That seems like what you want to do... is that not accurate?

I don't know why you are explicitly dimming things as Word.Application (which suggests you are utilizing this code somewhere other than within Word VBA) but not explicitly dimming range objects as Word.Range (which suggests you *are* using this code within Word VBA, since Dim r As Range isn't going to work the same in Excel VBA).

[Tom1212]

To Frosty:


>> 1. Look for a style ("CV Name") in your source document, and whatever the text of that style is...

YES

>> 2. You want to replace all instances of the style "Candidate Name" in the target document with the text contained in "CV Name" in the original document.

YES

>> This is a cleaned up version of your code...

YES

>> What isn't working?

get error 6124 (returned by command: rngStory.InsertAfter str)
get error 6124 (returned by command: rngStory.Text = str)

My attempts with Find and Slection commands (see the macro) do not make any text replacement...



Thank you for your advice in advance.

[Frosty]

Are you running this code from Word?

[Tom1212]

>> Are you running this code from Word?

YES, I am.

[Frosty]

Do you know how to step through code using F8? My guess is that you are not finding any text based on your criteria... and then everything breaks down.

Try stepping through the code and seeing what fails. Most likely it is that the style doesn't exist in the document.

I can provide some code later, but you should try to work on this on your own by simply recording macros rather than finding things on the web and throwing them together.

Can you record a macro which finds the first instance of the style "CV Name" in that specific document? What does that code look like?

[Tom1212]

My code can successfuly find the text having style "CV Name" (in the source document). The problem is no replacement is carried out.

Moreover, the following errors are raised

get error 6124 (returned by command: rngStory.InsertAfter str)
get error 6124 (returned by command: rngStory.Text = str)

rngStory includes proper text which I would like to replace by the target text.

How can I deal with the error 6124 ?

[Tom1212]

>> Why do you need to create the Word application?

I just wanted to open a Word document. Is it a wrong way?

[Frosty]

Try using F8 to step through this code and describe what happens that you don't expect, and what it doesn't do that you want it to do.

I have not tried to incorporate all of the functionality of your original code, because I'm not convinced you actually want any of that functionality. It seems like you want to replace all text in a given document, based on some styled text in a different document. The below code will do that.

If you want to do more than that, then you will need to describe what you want to do, and why you are using .InsertAfter at all.

Public Sub DemoCode()
Dim oSource As Document
Dim oTarget As Document
Dim sCVName As String

Set oSource = Documents.Open("your path here to source.dotx")
Set oTarget = Documents.Open("your path here to target.dotx")

'unprotect as necessary
If oTarget.ProtectionType <> wdNoProtection Then
oTarget.Unprotect Password:="12345"
End If

'get the text to replace from the source file
sCVName = fGetCVName(oSource)

'replace all instances in the target file
ReplaceCandidateName oTarget, sCVName

'now what?

End Sub
Public Function fGetCVName(oDoc As Document) As String
'find one instance of text styled with "CV Name" in the passed document
'return the string of text
Dim rngSearch As Range
Dim sRet As String

Set rngSearch = oDoc.Content
With rngSearch.Find
.Style = "CV Name"
If .Execute = True Then
sRet = rngSearch.Text
End If
End With

'if you want to get rid of any vbcr, then uncomment this line
'sRet = Replace(sRet, vbCr, "")
fGetCVName = sRet
End Function
Public Sub ReplaceCandidateName(oDoc As Document, sWithText As String)
'replace all instances of text formatted with Candidate Name style with the passed text
Dim rngSearch As Range

Set rngSearch = oDoc.Content
With rngSearch.Find
.Style = "Candidate Name"
.Replacement.Text = sWithText
.Execute Replace:=wdReplaceAll
End With
End Sub

[Tom1212]

Now, I get error 5844 (command: .Replacement.Text = sWithText)

[Frosty]

What is the description of the error? I do not have the error numbers memorized and cannot fathom what error could happen on that line of code.

You'll need to provide a bit more detail as well as whether you are able to step through using F8.

Even if you passed in nothing (i.e., a blank string), this code should still work. Even if the style Candidate Name didn't exist, this could should still work. Even if the document was protected, this code would fail on the ReplaceAll line of code.

I can't fathom a scenario where setting up the find object with specific replacement text would cause an error.

So, something else is going on. It may be your localized version of Word.

Steps for you to take:
1. What version of Word are you using
2. Record a macro which replaces all instances of text in an open document formatted with "Candidate Name" with any text... and then post that recorded macro.

If you can't do both of the above, I don't think I'll be able to help further. Sorry.

[fumei]

Yes, I am VERY curious about a 5844 error! AFAIK there is no such VBA error.