Microsoft Office Forums - View Single Post - VBA Word: Replace text, keep format, undo all

BigMac'ro · 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