自动为批量Word文档重命名等
可以用脚本来做。
1、用记事本新建一个文本文件,把它保存为“批量重命名.vbs”(注意不要弄成了“批量重命名.vbs.txt”,也就是要确保其扩展名为“.vbs”);2、把下列代码粘贴到这个VBS文件中:Option ExplicitConst 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 NextEnd 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 = strFullNameEnd Function3、修改代码中开始部分的两个设置,即:存放等待重命名的Word文件的根目录,以及获取文档第一段内容时最多保留多少个字符。
4、保存这个VBS文件,在资源管理器中双击运行它,直到看见“完成”!5、检查所有文件是否已自动重命名。
注意:如果有两个以上的文档依据其内容提取出来的文字相同,则会自动在文件名后面附加“_1”、“_2”、“_3”……。
如果有什么问题,请和我联系。
如何批量重命名word文件 doc docx格式
展开全部 快速以不同文件名重命名多个WORD文件: 1、利用批量重命名文件软件。
2、利用WIN的重命名功能进行命名。
(1)打开要重命名的文件夹 (2)将要重命名的所有文件选定 (3)将光标移动到选定区点击右键,点击重命名 (4)输入你想要的文件名,点击空白处,所有文件的名称都已重新命名了。
(5)因为是批量重命名,文件名称按顺序自动排列。
...
转载请注明出处51数据库 » word文档批量重命名