VBA Word: Replace text, keep format, undo all

BigMac'ro · #1 02-27-2025, 05:33 AM

Hi there,

I already posted a thread yesterday on another issue and received very competent advice on the topic. Many thanks again, I'm one step further now

I want to send an Email via Outlook, based on a recipients list in Excel and a text in Word. Thanks to the help yesterday, I can now keep the format of the Word doc in the email - very convenient.

Here comes the issue I have now: the script is actually part of a loop, there are several recipients, and the text should change accordingly for each recipient (Dear Ms xx, Dear Mr yy, etc). Here's what I do now:

Code:

For i = 2 To lastRow
    
    strKeyword = xlWS.Range(ColumnKeyword & i).Value 

    strKeyword2 = xlWS.Range(ColumnKeyword2 & i).Value 

    

    strAttach = xlWS.Range(ColumnAttach & i).Value
    strIndivAttach = Split(strAttach, ", ")     
        
    With Selection.Find
        .ClearFormatting
        .text = "%Keyword%"
        .Replacement.ClearFormatting
        .Replacement.text = strKeyword
        .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
    End With



    With Selection.Find
        .ClearFormatting
        .text = "%Keyword2%"
        .Replacement.ClearFormatting
        .Replacement.text = strKeyword2
        .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
    End With       



    doc.Range.Copy
       
       
   
    Set objMail = objOutlook.CreateItem(0)
     
    Dim olInsp As Object
    Dim wdDoc As Object
    Dim oRng As Object
       
       
    ' Email settings
    With objMail
        .To = "x@y.com"
        .CC = "x@y.com"
        .BCC = "x@y.com"
        .Subject = "subject"
        .BodyFormat = 2 
        
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        .Display
         oRng.Paste
        
        For a = LBound(strIndivAttach) To UBound(strIndivAttach) ' mehrere Anhänge berücksichtigen
            If Dir(strIndivAttach(a)) <> "" Then
                .Attachments.Add (strIndivAttach(a))
            End If
        Next a
        
        .Send
    End With

    ActiveDocument.Undo 2
Next i

That works, but I have to count the number of "With" blocks at the beginning of the code, and then put that number in ActiveDocument.Undo, which is a bit tedious.
I was thinking of recording the process within the loop and undoing it at the end of the loop, beginning with

Code:

Dim objUndo As UndoRecord


For i = 2 To lastRow


Set objUndo = Application.UndoRecord
objUndo.StartCustomRecord ("Record")

and then at the end:

Code:

 objUndo.EndCustomRecord
    ActiveDocument.Undo


Next i

I thought this would avoid counting the with-blocks, as everything is recorded as one action. But I was wrong, Microsoft office just crashed when I execute this code.

So my questions now:
- what's the problem with the recording?
- Maybe any idea how to avoid pasting several "With" blocks and integrate that into another loop?

Many thanks

Italophile · #2 02-27-2025, 09:33 AM

Why do you need to undo your actions? Can’t you just close the document without saving?

Or, if you start from the same content each time, save the document as a template and create a new document from it each time. That way the original content never gets changed.

macropod · #3 02-27-2025, 01:50 PM

So why aren't you using mailmerge?

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Find and replace paragraph mark on selected text and replace it with space in PowerPoint VBA	laith93	PowerPoint	0	11-09-2023 04:34 AM
undo in word 2007	agentm	Word	7	07-25-2018 01:53 PM
how to replace a text in word by cell value (bulleted text) using macro	Gowri	Word VBA	8	03-26-2017 04:14 AM
Undo highlighted text	rohanrohith	Word VBA	1	11-27-2014 04:02 PM
Undo Arrange All in Word	nineball	Word	1	10-11-2013 12:36 PM