BJennin4
BJennin4

Reputation: 11

VBA, setting a range in a Word document to edit a specific section of text

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.

Upvotes: 1

Views: 1597

Answers (1)

Oscar  Sun
Oscar Sun

Reputation: 1479

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

Upvotes: 1

Related Questions