asked on

Replace using collection in VBA

I need to build replace option in below code using VBA WORD:

I want add replace option in below code:

Public Sub Macro1()
Dim docWord As Document
Set docWord = ActiveDocument
Dim strFilePath As String
Dim docTxt As Document
Dim para As Paragraph
Dim rng As Range
Dim rp As String

Dim coll As Collection
Set coll = New Collection

Dim coll2 As Collection
Set coll2 = New Collection

strFilePath = "C:\acs\text.txt"
Set docTxt = Documents.Open(strFilePath)

For Each para In docTxt.Paragraphs
Set rng = para.Range
rng.MoveEnd wdCharacter, -1
If Len(rng) > 0 Then
coll.Add rng.Text
coll2.Add rng.Text
End If
Next para
'Close Textfile
With Application
.ScreenUpdating = False
.Documents(strFilePath).Close SaveChanges:=wdDoNotSaveChanges
End With

If coll.Count > 0 Then
For i = 1 To coll.Count
With docWord.Range.Find
.Text = coll(i)
.MatchCase = False
If Not .Execute() Then
MsgBox coll(i) & " Not Found in Word Document"
Else
MsgBox coll(i) & " Found in Word Document"
rp = InputBox("Enter the replacement", "REPLACE")
End If
End With
Next i
End If
End Sub

aikimark

I've placed your code into a code snippet and formatted it for readability (below)
Why are you iterating the collection with your string find logic? To me it seems easier to use the find/replace methods built into the Word object model.

Public Sub Macro1()
    Dim docWord As Document
    Set docWord = ActiveDocument
    Dim strFilePath As String
    Dim docTxt As Document
    Dim para As Paragraph
    Dim rng As Range
    Dim rp As String
    
    Dim coll As Collection
    Set coll = New Collection
    
    Dim coll2 As Collection
    Set coll2 = New Collection
    
    strFilePath = "C:\acs\text.txt"
    Set docTxt = Documents.Open(strFilePath)
    
    For Each para In docTxt.Paragraphs
        Set rng = para.Range
        rng.MoveEnd wdCharacter, -1
        If Len(rng) > 0 Then
            coll.Add rng.Text
            coll2.Add rng.Text
        End If
    Next para
    'Close Textfile
    With Application
        .ScreenUpdating = False
        .Documents(strFilePath).Close SaveChanges:=wdDoNotSaveChanges
    End With
    
    If coll.Count > 0 Then
        For i = 1 To coll.Count
            With docWord.Range.Find
                .Text = coll(i)
                .MatchCase = False
                If Not .Execute() Then
                    MsgBox coll(i) & " Not Found in Word Document"
                Else
                    MsgBox coll(i) & " Found in Word Document"
                    rp = InputBox("Enter the replacement", "REPLACE")
                End If
            End With
        Next i
    End If
End Sub

Open in new window

ASKER CERTIFIED SOLUTION

Neil Fleming

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Steven Reynolds

ASKER

Yes. Collections not needed for this instance and thank you very much for your suggestion.