可以用脚本来做。

1、用记事本新建一个文本文件，把它保存为“批量重命名.vbs”（注意不要弄成了“批量重命名.vbs.txt”，也就是要确保其扩展名为“.vbs”）;

2、把下列代码粘贴到这个VBS文件中： Option Explicit Const g_strRootPath = ＂c:/Temp/docs/Word/ToRename/＂ ' 指定存放所有文件的目录，可以有子目录 Const g_nTitleMaxLen = 16 ' 指定获取文档里面第一段中的前多少个字符来作为文件名 Call Main ' 主函数入口 Sub Main() Dim fso, oFolder, oWordApp Set oWordApp = CreateObject(＂Word.Application＂) Set fso = CreateObject(＂Scripting.FileSystemObject＂) Set oFolder = fso.GetFolder(g_strRootPath) RenameDocFilesUnderFolder oWordApp, fso, oFolder oWordApp.Quit Set oWordApp = Nothing MsgBox ＂完成！＂ end Sub ' 重命名指定文件夹（递归）下面的所有Word文件，按照文件里面的第一句可见的文字命名 Sub RenameDocFilesUnderFolder(oWordApp, fso, oFolder) Dim oSubFolder, oFile, oDoc Dim strTitle, strFileName For Each oSubFolder In oFolder.SubFolders RenameDocFilesUnderFolder oWordApp, fso, oSubFolder next For Each oFile In oFolder.Files Set oDoc = oWordApp.Documents.Open(oFile.Path) strTitle = GetFirstVisibleTextContent(oDoc) oDoc.Close Set oDoc = Nothing If Len(strTitle)0 Then strFileName = fso.BuildPath(fso.GetParentFolderName(oFile.Path), strTitle & ＂.＂ & fso.GetExtensionName(oFile.Path)) strFileName = GetUniqueFileName(fso, strFileName) fso.MoveFile oFile.Path, strFileName end If next end Sub ' 获取指定文档第一行可见文字 Function GetFirstVisibleTextContent(oDoc) Dim oParagraph Dim strContent For Each oParagraph In oDoc.Paragraphs strContent = GetSafeFileName(oParagraph.Range.Text) If Len(strContent)0 Then GetFirstVisibleTextContent = strContent Exit Function end If next GetFirstVisibleTextContent = ＂＂ end Function ' 过滤文件名里面的无效字符 Function GetSafeFileName(strFileName) Dim arrUnsafeCharacters, strUnsafeChar Dim nIndex arrUnsafeCharacters = Array(＂/＂, ＂/＂, ＂:＂, ＂*＂, ＂?＂, ＂＂＂＂, ＂＂, ＂|＂) For nIndex = 0 To &H2F strFileName = Replace(strFileName, Chr(nIndex), ＂＂) next For Each strUnsafeChar In arrUnsafeCharacters strFileName = Replace(strFileName, strUnsafeChar, ＂＂) next GetSafeFileName = left(Trim(strFileName), g_nTitleMaxLen) end Function ' 获取不重复的文件名，如果有重名则在文件名后面附加“_1”、“_2”…… Function GetUniqueFileName(fso, strFullName) Dim strParentFolder, strBaseName, strExtensionName Dim nIndex If Not fso.FileExists(strFullName) Then GetUniqueFileName = strFullName Exit Function end If strParentFolder = fso.GetParentFolderName(strFullName) strBaseName = fso.GetBaseName(strFullName) strExtensionName = fso.GetExtensionName(strFullName) nIndex = 0 While fso.FileExists(strFullName) nIndex = nIndex + 1 strFullName = fso.BuildPath(strParentFolder, strBaseName & ＂_＂ & nIndex & ＂.＂ & strExtensionName) Wend GetUniqueFileName = strFullName End Function

3、修改代码中开始部分的两个设置，即：存放等待重命名的Word文件的根目录，以及获取文档第一段内容时最多保留多少个字符。

4、保存这个VBS文件，在资源管理器中双击运行它，直到看见“完成”！

5、检查所有文件是否已自动重命名。 注意：如果有两个以上的文档依据其内容提取出来的文字相同，则会自动在文件名后面附加“_1”、“_2”、“_3”……。 如果有什么问题，请和我联系。

2、word怎么批量改文件名比如有几十部电影文件每部名字前面都有一

用批处理结合Word可以实现，推荐的步骤如下：

1. 在电影所在文件夹下，用记事本创建一个 list.bat 的批处理文件，内容如下：

dir /on /b *.mkv > filename.txt

（如果电影扩展名不是mkv，请改成实际的扩展名，例如rmvb）

运行，得到filename.txt，里面包含了该文件夹下全部mkv文件。

2. 用Word打开filename.txt，选中全部行，选择文本转换为表格，生成只有一列的表格；前面增加一列，后面增加一列。第一列内容用复制粘贴的办

法输入ren，最后一列内容把文件名列复制一份。选中最后一列，使用替换功能，把“欢迎关注微信号”替换为空。

3. 表格转换为文本，用空格分隔；然后把 filename.txt 重命名为 filename.bat，运行即可。

3、怎样同时改多个WORD的文件名我想同时在多个文件名后加1个字

用CMD+Excel就能够完成。下面以批量修改F：/歌曲文件夹中的歌曲名为例说明首先获得Word文档的文件名。打开cmd（命令提示符），输入：cd /d F：/歌曲回车后将F：/歌曲设置成当前文件夹。再输入dir /b *.mp3gequming.txt注：以后的是保存歌曲名的文件名gequming.txt。用记事本打开刚刚生成的gequming.txt文件，全选，在Excel工作表A1开始粘贴。在B1输入下面的公式，并向下复制=LEFT(A1,LEN(A1)⑷）-要添加的字说明：由于歌曲的扩大名是.mp3，总计4个字符，所以公式中用A1的字符数减去4，以获得文件名。高版本的Word扩大名为docx，这样公式中的4就要改成5，后面用ren .mp3这样Excel中的界面以下图所示。复制C列内容，返回到CMD窗口，右击，粘贴（下图是CMD窗口的右击菜单）。查看1下文件名是不是修改成功。