求提取txt文件第一行作为文件名的批处理
Option Explicit
On Error Resume Next ' 容错语句，避免程序崩溃 '有可能重命名文件已经存在，忽略错误。
Dim fso,fs,f
Dim i
Dim strNewName
Const strCurrentPath = "。 "
Msgbox "根据文本文件第一行批量重命名的VBS程序" & vbcrlf & vbcrlf & "Created By Shortway",0," "
Set fso = Wscript。 CreateObject("Scripting。FileSystemObject")
Set fs = fso。GetFolder...全部
Option Explicit
On Error Resume Next ' 容错语句，避免程序崩溃 '有可能重命名文件已经存在，忽略错误。
Dim fso,fs,f
Dim i
Dim strNewName
Const strCurrentPath = "。
"
Msgbox "根据文本文件第一行批量重命名的VBS程序" & vbcrlf & vbcrlf & "Created By Shortway",0," "
Set fso = Wscript。
CreateObject("Scripting。FileSystemObject")
Set fs = fso。GetFolder(strCurrentPath)。Files
i = 0
For Each f In fs '遍历当前文件夹内每个文件
If LCase(right( ,3))="txt" Then '判断是否是文本文件
strNewName = Trim(fso。
OpenTextFile(f, 1, False)。ReadLine) '得到第一行
'以下剔除不能作文件名的特殊字符
strNewName = Replace(strNewName, "\", "")
strNewName = Replace(strNewName, "/", "")
strNewName = Replace(strNewName, ":", "")
strNewName = Replace(strNewName, "*", "")
strNewName = Replace(strNewName, "?", "")
strNewName = Replace(strNewName, """", "")
strNewName = Replace(strNewName, ">", "")
strNewName = Replace(strNewName, "<", "")
strNewName = Replace(strNewName, "|", "")
strNewName = left(strNewName,50) '有时第一行文字太多了，就选50个字符了
=strNewName & "。
txt"
i = i + 1
End if
Next
Msgbox i & "个文件改名完成！（忽略重名）"
Set fs = Nothing
Set fso = Nothing
。
收起
