6个回答
展开全部
可以用脚本来做。
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”……。
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”……。
展开全部
如果你电脑上使用的解压缩程序是 360压缩 ,那么,请参考下面的文章,即可对同一个文件夹中的文件进行批量重命名了。
http://jingyan.baidu.com/article/e2284b2b45e893e2e6118dff.html
如果对此文章内容或者命名规则不满意,可以在百度上搜索 批量重命名工具,然后按照下载的工具使用方法对文档进行批量重命名。
http://jingyan.baidu.com/article/e2284b2b45e893e2e6118dff.html
如果对此文章内容或者命名规则不满意,可以在百度上搜索 批量重命名工具,然后按照下载的工具使用方法对文档进行批量重命名。
本回答被提问者和网友采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
文件夹批量重命名
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
一直没找到什么办法,都是逐一进行更名。不知道其他的朋友有没有好办法。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
这个不能,只能逐一进行
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |