2024年1月22日发(作者：)
批量更换word文档的文件名称
本文提供多个相似名称的word文档批量更换名称的VBA代码。包含两种操作代码。
一种是在文件名后面增加备注字符；一种是替换文件名当中的相同字符。
操作方法如下所示：
1、打开VBA窗口，复制粘贴文后的代码至程序中。
2、关闭VBA窗口，重新运行宏程序。选择不同的操作，即可进行相应操作。
3测试在文件名尾部增加内容的程序
3.1在宏操作窗口中，选择既有文件名尾部增加内容，点击运行。
3.2选择文件，一次选择多个文件，点击确定。
3.3输入尾部增加的字符，点击确定。
3.4完成窗口提示，确定。
3.5已经增加成功。
4测试更换字符串
4.1在宏操作窗口中，选择替换文件名字符，点击运行
4.2选择文件，一次选择多个文件，点击确定。
4.3输入需要替换的老字符，建议从文件名中复制后粘贴到此处，防止有空格未复制到。
4.4输入需要替换成的新字符，确定。
4.5完成窗口提示，确定。
4.6已经替换字符成功。
附件代码：
Sub 替换文件名字符()
'此代码为指定文件夹中所有选取的WORD文件的文件名部分字符替换
Dim MyDialog As FileDialog, vrtSelectedItem As Variant, Doc As Document
Dim NewName As String, thisPath As String
On Error Resume Next '忽略错误
'定义一个文件夹选取文件的对话框
Set MyDialog = alog(msoFileDialogFilePicker)
With MyDialog
. '清除所有文件筛选器中的项目
. "所有WORD 文件", "* .doc", 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True ' 允许多项选择
If .Show = -1 Then '确定
OldPas = InputBox("请输入需要替换的老字符: ")
NewPas = InputBox("请输入需要替换成的新字符: ")
Updating = False
For Each vrtSelectedItem In .SelectedItems '在所有选取项目中循环
Set Doc = (FileName:=vrtSelectedItem,
Visible:=False)
e FindText:=OldPas,
ReplaceWith:=NewPas, Replace:=wdReplaceAll
True
' 修改文件名
NewName = Replace(vrtSelectedItem, OldPas, NewPas & " ")
If NewName <> "" Then
Name vrtSelectedItem As NewName
End If
Next
Updating = True
End If
End With
Set Doc = Nothing '释放变量
MsgBox "文件名更改完毕， 请检查", vbInformation
End Sub
Sub 既有文件名尾部增加内容()
'此代码为指定文件夹中所有选取的WORD文件的文件名部分字符替换
Dim MyDialog As FileDialog, vrtSelectedItem As Variant, Doc As Document
Dim NewName As String, thisPath As String
On Error Resume Next '忽略错误
'定义一个文件夹选取文件的对话框
Set MyDialog = alog(msoFileDialogFilePicker)
With MyDialog
. '清除所有文件筛选器中的项目
. "所有WORD 文件", "* .doc", 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True ' 允许多项选择
If .Show = -1 Then '确定
NewPas = InputBox("请输入需要在尾部增加的字符: ")
Updating = False
For Each vrtSelectedItem In .SelectedItems '在所有选取项目中循环
Set Doc = (FileName:=vrtSelectedItem,
Visible:=False)
e FindText:=".doc",
ReplaceWith:=NewPas, Replace:=wdReplaceAll
True
' 修改文件名
NewName = Replace(vrtSelectedItem, ".doc", NewPas & ".doc")
If NewName <> "" Then
Name vrtSelectedItem As NewName
End If
Next
Updating = True
End If
End With
Set Doc = Nothing '释放变量
MsgBox "文件名更改完毕， 请检查", vbInformation
End Sub
发布评论