I am working with VBA in an xlsx document, and I am attempting to alter a separate rtf document to replace the words in a specific range between two tags on the document. I have managed to replace all the instances of any word across the entire document, and have also managed to retrieve the text in the range between the tags. If I try to set a range however, I end up getting either a type mismatch on the range, or an error saying the object variable or With block variable not set.
Public Sub WordFindAndReplaceTEST()
Dim ws As Worksheet, msWord As Object
Dim firstTerm As String
Dim secondTerm As String
Dim documentText As String
Dim myRange As Range
Dim startPos As Long 'Stores the starting position of firstTerm
Dim stopPos As Long 'Stores the starting position of secondTerm based on first term's location
Dim nextPosition As Long 'The next position to search for the firstTerm
nextPosition = 1
firstTerm = "<Tag2.1.1>"
secondTerm = "</Tag2.1.1>"
On Error Resume Next
Set msWord = GetObject(, "Word.Application")
If wrdApp Is Nothing Then
Set msWord = CreateObject("Word.Application")
End If
On Error GoTo 0
Set ws = ActiveSheet
With msWord
.Visible = True
.Documents.Open "C:\Users\user\Desktop\ReportTest\ReportDoc.rtf"
.Activate
'Get all the document text and store it in a variable.
documentText = .ActiveDocument.Content
'Loop documentText till you can't find any more matching "terms"
Do Until nextPosition = 0
startPos = InStr(nextPosition, documentText, firstTerm, vbTextCompare)
stopPos = InStr(startPos, documentText, secondTerm, vbTextCompare)
nextPosition = InStr(stopPos, documentText, firstTerm, vbTextCompare)
Loop
Set myRange = Nothing
myRange.SetRange Start:=startPos, End:=stopPos 'Error thrown here
MsgBox .ActiveDocument.Range(startPos, stopPos) 'Successfully returns range as string
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "toReplace"
.Replacement.Text = "replacementText"
.Forward = True
.Wrap = 1
.format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2
End With
'Overrides original
'.Quit SaveChanges:=True
End With
End Sub
I initially tried to assign myRange without setting it first. I have tried moving the scope of myRange and the declaration of myRange. I have tried to Set myRange = .ActiveDocument.Range or .ActiveDocument.Content.
I have also tried replacing the line: With .ActiveDocument.Content.Find with With .ActiveDocument.myRange(startPos, stopPos).Find
Anything I try throws an error, and I have tried looking around for similar issues and reading the VBA docs but have yet to figure out where the issue lies.
I initially tried to assign myRange without setting it first.
it just had to be initialized to a range other than Nothing.
Using Word.Range object, you have to initiate it by Set that object to a range in a document first, just like what you said:
I have tried to Set myRange = .ActiveDocument.Range or .ActiveDocument.Content.
All errors you met just because you placed Loop in the wrong place!
OK, then use my code to perform first to check it out. If you do not need to watch the OP process then not show up the MS Word app will be better.
Public Sub WordFindAndReplaceTEST()
Dim ws As Worksheet, msWord As Object
Dim firstTerm As String
Dim secondTerm As String
Dim documentText As String
'Dim myRange As Range
Dim myRange As Word.Range ' just like Timothy Rylatt said
Dim startPos As Long 'Stores the starting position of firstTerm
Dim stopPos As Long 'Stores the starting position of secondTerm based on first term's location
Dim nextPosition As Long 'The next position to search for the firstTerm
Dim d As Word.Document 'use this to OP the opened document instead of ActiveDocument
nextPosition = 1
firstTerm = "<Tag2.1.1>"
secondTerm = "</Tag2.1.1>"
On Error Resume Next
Set msWord = GetObject(, "Word.Application")
Rem wrdApp should be msWord
'If wrdApp Is Nothing Then
If msWord Is Nothing Then
Set msWord = CreateObject("Word.Application")
End If
On Error GoTo 0
Set ws = ActiveSheet
With msWord
.Visible = True
'.Documents.Open "C:\Users\user\Desktop\ReportTest\ReportDoc.rtf"
Rem using this to OP the opened document instead of ActiveDocument is better
Set d = .Documents.Open("C:\Users\user\Desktop\ReportTest\ReportDoc.rtf")
' Set d = .Documents.Open("X:\PS Test\1.rtf") 'this for my test
.Activate
'Get all the document text and store it in a variable.
'documentText = .ActiveDocument.Content
documentText = d.Content
Rem Using Word.Range object, you have to initiate it by `Set` that object to a range in a document first
Set myRange = d.Range
'Loop documentText till you can't find any more matching "terms"
Do Until nextPosition = 0
startPos = InStr(nextPosition, documentText, firstTerm, vbTextCompare)
stopPos = InStr(startPos, documentText, secondTerm, vbTextCompare)
nextPosition = InStr(stopPos, documentText, firstTerm, vbTextCompare)
'Loop ' Wrong place to close the loop!!
'Set myRange = Nothing 'this is meanless!
myRange.SetRange Start:=startPos, End:=stopPos 'Error thrown here
'MsgBox .ActiveDocument.Range(startPos, stopPos) 'Successfully returns range as string
'myRange.Select 'just for test to check out
'With .ActiveDocument.Content.Find
'With d.Content.Find' this will replace all text of the opened file not only the range
With myRange.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "toReplace"
.Replacement.Text = "replacementText"
.Forward = True
'.Wrap = 1 'wdFindContinue' this will replace all text of the opened file not only the range
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll
End With
Loop
'Overrides original
'.Quit SaveChanges:=True 'this will save all your files if `GetObject(, "Word.Application")` succeed.
If Not d.Saved Then
d.Close Word.wdSaveChanges
Else
d.Close 'when there is nothing to be replaced. However, open .rtf files in MS Word seem to be modified.
End If
If .Documents.Count = 0 Then .Quit
End With
End Sub