用ChatGPT写宏代码，实现Word文档内容的批量替换

我有一个需求，就是同时实现多个Word文档的多个内容批量替换。

先百度，找到一个Word批量工具软件。测试发现不支持docx格式。可能软件版本比较老的缘故。

后来想，还是用宏代码来实现这个功能得了。听说ChatGPT写代码很厉害，正好来测试一下。

继续百度，找国内免费可以用的ChatGPT网址。然后试用。

不同的问法，得到了不同的代码。经过测试，都没有成功。

按道理来说，宏代码不是什么高深的代码，对于ChatGPT来说，应该是小儿科才对。怎么还会出错呢？

我把出错的代码和提示复制到对话。才搞清楚，原来是代码引用了对象库。按照提示，添加了 Word 对象库的引用后，再次测试宏代码。一切正常了。

附上不同的代码和对话：

1.代码一：替换同一个文件夹内的多个Word文档的相同内容。

Sub 替换()

Application.ScreenUpdating = False '关闭屏幕闪

Dim myFile$, myPath$, i%, myDoc As Object, myAPP As Object, txt$, Re_txt$

Set myAPP = New Word.Application

With Application.FileDialog(msoFileDialogFolderPicker) '允许用户选择一个文件夹

.Title = "选择Word所在文件夹"

If .Show = -1 Then

myPath = .SelectedItems(1) '读取选择的文件路径

Else

Exit Sub

End If

End With

myPath = myPath & ""

myFile = Dir(myPath & "*.docx")

txt = InputBox("需要替换的文字：")

Re_txt = InputBox("替换成：")

myAPP.Visible = True '是否显示打开文档

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 = False

.MatchWholeWord = False

.MatchByte = True

.MatchWildcards = False

.MatchSoundsLike = False

.MatchAllWordForms = False

.Execute Replace:=2

End With

End If

myDoc.Save

myDoc.Close

myFile = Dir

Loop

myAPP.Quit '关掉临时进程

Application.ScreenUpdating = True

MsgBox ("全部替换完毕！")

End Sub

2.代码二：替换同一个文件夹内的多个Word文档的多个要替换的内容。

Sub ReplaceMultiContentInMultipleDocs()

' 定义需要替换的多个文字

Dim OldTexts(4) As String

OldTexts(0) = "要替换的文字1"

OldTexts(1) = "要替换的文字2"

OldTexts(2) = "要替换的文字3"

OldTexts(3) = "要替换的文字4"

' 定义将使用的新文本替换每个旧文本

Dim NewTexts(4) As String

NewTexts(0) = "新文字1"

NewTexts(1) = "新文字2"

NewTexts(2) = "新文字3"

NewTexts(3) = "新文字4"

' 定义需要批处理的文件夹

Dim FolderPath As String

FolderPath = "C:UsersUsernameDesktopTestFiles" ' 请根据情况修改

' 打开 Word 应用程序窗口

Dim WdApp As Object

Set WdApp = CreateObject("Word.Application")

WdApp.Visible = True

' 循环查找并打开指定文件夹下的所有 Word 文档

Dim FileList() As String, FileName As Variant

FileList = Split(CreateObject("WScript.Shell").Exec("cmd /c Dir """ & FolderPath & "*.doc*"" /s /b").StdOut.ReadAll, vbCrLf)

For Each FileName In FileList

' 打开文档并使用 Find-Replace 完成批量替换指定文字

Dim WdDoc As Object, i As Integer

Set WdDoc = WdApp.Documents.Open(FileName)

For i = 0 To UBound(OldTexts)

With WdDoc.Content.Find

.Text = OldTexts(i)

.Replacement.Text = NewTexts(i)

.Execute Replace:=2

End With

Next i

' 保存并关闭当前文档

WdDoc.Save

WdDoc.Close

Next FileName

' 关闭 Word 应用程序窗口

WdApp.Quit

Set WdApp = Nothing

MsgBox "已完成批量替换文本操作。"

End Sub