如何给word文件自动更名？如何给word文件自动更名：文件名字
可以用脚本来做。
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 Function3、修改代码中开始部分的两个设置，即：存放等待重命名的Word文件的根目录，以及获取文档第一段内容时最多保留多少个字符。
4、保存这个VBS文件，在资源管理器中双击运行它，直到看见“完成”！5、检查所有文件是否已自动重命名。
注意：如果有两个以上的文档依据其内容提取出来的文字相同，则会自动在文件名后面附加“_1”、“_2”、“_3”……。
如果有什么问题，请和我联系。
转载请注明出处51数据库 » word 重命名文件 宏
