Use VBA to replace multiple Word contents in batches (with window interface/support backup, case, wildcard, etc.)

Background: My friend has multiple Word files at work, and the date in the document must be updated every time an update is made. Manual changes are time-consuming, and the company’s computer cannot install unauthorized software, and only supports English. Therefore, according to this requirement, I refer to some online codes, and make some upgrades, adding functions such as interface and backup, and create this VBA. Below is the VBA code for the main parts.

Figure 1 VBA structure diagram

Figure 2 Form interface

'窗体界面
Private Sub CommandButton1_Click() 'Replace按钮
Call Start_replace
Unload Me
End Sub

Private Sub CommandButton2_Click() 'Clear按钮
'CheckBox1.Value = False
'CheckBox2.Value = False
'CheckBox3.Value = False
'CheckBox4.Value = False
TextBox1.Value = ""
TextBox2.Value = ""
End Sub

'调用窗体界面(模块1)
Sub Replace_text()
UserForm1.Show
End Sub

'开始替换(模块2)
Public Sub Start_replace()
Application.ScreenUpdating = False  '关闭屏幕闪
Dim myFile$, myPath$, backup_file, Backup_path, i%, myDoc As Object, myBackup As Object, myAPP As Object, txt$, Re_txt$
Set myAPP = New Word.Application
With Application.FileDialog(msoFileDialogFolderPicker) '允许用户选择一个文件夹
    .Title = "选择目标文件夹"
    If .Show = -1 Then
        myPath = .SelectedItems(1) '读取选择的文件路径
    Else
        Exit Sub
    End If
End With
myPath = myPath & ""

MatchCase_Value = UserForm1.CheckBox1.Value
MatchWholeWord_Value = UserForm1.CheckBox2.Value
MatchByte_Value = UserForm1.CheckBox3.Value
MatchWildcards_Value = UserForm1.CheckBox4.Value
Backup = UserForm1.CheckBox5.Value
Be_replaced = UserForm1.TextBox1.Value
Replace_with = UserForm1.TextBox2.Value

txt = Be_replaced
Re_txt = Replace_with
myAPP.Visible = True '是否显示打开文档

'Backup
If (Backup = True) Then
    Backup_path = "E:\backup\"
    backup_file = Dir(myPath & "\*.doc*")
    Do While backup_file <> ""
        Set myBackup = myAPP.Documents.Open(myPath & "\" & backup_file)
        myBackup.SaveAs "E:\backup\" & backup_file
        myBackup.Close
        backup_file = Dir
    Loop
End If

'Replace
myFile = Dir(myPath & "\*.doc*")
Count = 0
Do While myFile <> "" '文件不为空
    Set myDoc = myAPP.Documents.Open(myPath & "\" & myFile)
    If myDoc.ProtectionType = wdNoProtection Then '是否受保护
        With myDoc.Content.Find
            .Text = txt
            .Replacement.Text = Re_txt
            .Forward = True
            .Wrap = 2
            .Format = False
            .MatchCase = MatchCase_Value
            .MatchWholeWord = MatchWholeWord_Value
            .MatchByte = MatchByte_Value
            .MatchWildcards = MatchWildcards_Value
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=2
        End With
    End If
    myDoc.Save
    myDoc.Close
    myFile = Dir
    Count = Count + 1
Loop
myAPP.Quit '关掉临时进程
Application.ScreenUpdating = True
If (Backup = True) Then
    MsgBox (Count & " documents replaced successfully and backup in " & Backup_path)
ElseIf (Backup = False) Then
    MsgBox (Count & " documents replaced successfully!")
End If
End Sub

Figure 3 running results

• Disadvantages: At present, only all words in a folder can be replaced in batches, and selection cannot be made; the matched content cannot be viewed in real time, so it is recommended to copy the file to a temporary folder before replacing. (despite the backup feature)
• This article Word download address

Link: https://pan.baidu.com/s/1ZsrfjK3GY4cLOlkm-h12rQ
Extraction code: mup5