阿里云-云小站(无限量代金券发放中)
【腾讯云】云服务器、云数据库、COS、CDN、短信等热卖云产品特惠抢购

简单介绍VBS批量重命名文件并且操作前备份原有文件

90次阅读
没有评论

共计 5302 个字符,预计需要花费 14 分钟才能阅读完成。

导读 这篇文章主要介绍了 VBS 批量重命名文件并且操作前备份原有文件, 需要的朋友可以参考下
核心函数
'=========================================================================='
'VBScript Source File -- Created with SAPIEN Technologies PrimalScript 4.0'
'NAME:'
'AUTHOR: Microsoft , Microsoft' DATE : 2014/7/9
'' COMMENT:' 批量修改文件夹下对应的所有文件名
''==========================================================================' 选择我的电脑作为根目录,来选择目录
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(MY_COMPUTER)
Set objFolderItem = objFolder.Self
strPath = objFolderItem.Path
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder:", OPTIONS, strPath)
If objFolder Is Nothing Then
Wscript.Quit
End If
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
'MsgBox objFolderItem.name'===================================================================
'选择指定盘符下的目录' Const WINDOW_HANDLE = 0
'Const OPTIONS = 0' 
'Set objShell = CreateObject("Shell.Application")' Set objFolder = objShell.BrowseForFolder _
'(WINDOW_HANDLE,"Select a folder:", OPTIONS,"C:\")' 
'If objFolder Is Nothing Then' Wscript.Quit
'End If' 
'Set objFolderItem = objFolder.Self' objPath = objFolderItem.Path
'' MsgBox objPath'=========================================================================
' 定义变量
dim file_path,prefix_name,suffix_name,repeat_name,repeat_edit
Dim OneLine,TwoLine,ThreeLine,FourLine,FiveLine
i=0
test = createobject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path
'Wscript.echo test
filepath=test&"\config.ini"
'WScript.Echo filepath' file_path = "C:\Users\Administrator\Desktop\1\music"' 目标文件夹的路径
dst_file_path="C:\"&objFolderItem.name&"_bak"
file_path=objPath
'----- 得到文件夹路径,且打开配置文件
Set fso = CreateObject("Scripting.FileSystemObject") 
Set folder = fso.getfolder(file_path) 
Set fs = folder.files
Set file=fso.OpenTextFile(filepath,1)
'---------------- 在操作前,备份一下原有的文件
fso.CopyFolder file_path,dst_file_path,True
'----------------------------------' 取出第一行中的两个数
OneLine=file.ReadLine
OneLineStr=Split(OneLine,"=")
OneLineCount=UBound(split(OneLine,"="))
For i1=0 To OneLineCount
'WScript.Echo OneLineStr(i1)
Next
'-------------------------------------' 取出第二行中的两个数
TwoLine=file.ReadLine
TwoLineStr=Split(TwoLine,"=")
TwoLineCount=UBound(split(TwoLine,"="))
For i2=0 To TwoLineCount
'WScript.Echo TwoLineStr(i2)
Next
'-------------------------------------------' 取出第三行中的两个数
ThreeLine=file.ReadLine
ThreeLineStr=Split(ThreeLine,"=")
ThreeLineCount=UBound(split(ThreeLine,"="))
For i3=0 To ThreeLineCount
'WScript.Echo ThreeLineStr(i3)
Next
'-------------------------------------------' 取出第四行中的两个数
FourLine=file.ReadLine
FourLineStr=Split(FourLine,"=")
FourLineCount=UBound(split(FourLine,"="))
For i4=0 To FourLineCount
'WScript.Echo FourLineStr(i4)
Next
'-----------------------------------------' 取出第五行中的两个数
FiveLine=file.ReadLine
FiveLineStr=Split(FiveLine,"=")
FiveLineCount=Ubound(split(FiveLine,"="))
For i5=0 To FiveLineCount
'WScript.Echo FiveLineStr(i5)
Next
'---------------------------------------------' 调用过程
'Function_Main()
Function Function_Main()
If OneLineStr(1)="true" Then
Function_Prefix_Name()
Elseif OneLineStr(1)="false" Then
Function_Suffix_Name()
Elseif OneLineStr(1)="number" Then 
Function_Number_Value()
Elseif OneLineStr(1)="array" Then  
Function_MyArrayReName()
Elseif OneLineStr(1)="" Then
WScript.Quit
End If
End Function
'-----------------------------------------' 在原有名称前增加前缀
Function Function_Prefix_Name()
For Each file in fs
File.Name=TwoLineStr(1)&File.Name
Next
End Function
'--------------------------------------' 在原有名称前增加后缀
Function Function_Suffix_Name()
For Each file in fs
Name=Mid(file.name,1,instrrev(file.name,".")-1) ' 取到. 号前面的文件名
Format=Mid(file.name,instrrev(file.name,".")) ' 取到. 号后面的后缀格式
file.Name=Name&ThreeLineStr(1)&Format
Next
End Function
'--------------------------------------------' 在原有名称前增加有序自增数字
Function Function_Number_Value()
For Each file In fs
FourLineStr(1)=FourLineStr(1)+1
file.name=FourLineStr(1)&file.name
Next
End Function
'Function_Suffix_Name()'--------------------------------------------------
' 批量更改文件名称
Function Function_MyArrayReName()
Const BeforAlarm="发生犯人暴狱,请注意观察"
Const AfterAlarm="发生犯人暴狱,各小组按预案处置"
Dim MyArray(12)
n=1
y=0
For i=0 To 12
If i=11 Then
MyArray(i)="监门哨"
Elseif i=12 Then
MyArray(i)="自卫哨"
Else
MyArray(i)=n&"号哨"
n=n+1
End If
' WScript.Echo MyArray(i)
Next
For Each file In fs
Format=Mid(file.name,instrrev(file.name,".")) 
'MsgBox Format'MsgBox MyArray(y)
If FiveLineStr(1)="before" Then
file.name=MyArray(y)&BeforAlarm&Format
Elseif FiveLineStr(1)="after" Then
file.name=MyArray(y)&AfterAlarm&Format
Else
MsgBox "请先设置是确认前还是确认后!",,"提示"
WScript.Quit
End If
y=y+1
'WScript.Echo file.name
Next
End Function
  
'=======================================================================' If prefix_name  ""then' 批量加前缀
'For each f in fs' f.name = prefix_name&f.name
'Next' End If
'' if suffix_name"" then'批量加后缀' For each f in fs
'name = Mid(f.name,1,InstrRev(f.name,".")-1)' format = Mid(f.name,InstrRev(f.name,"."))
'f.name = name & suffix_name & format' Next
'end If' 
'if repeat_name"" then'批量删除相同字符' For each f in fs
'On Error Resume Next' f.name = Replace(f.name,repeat_name,repeat_edit)
'Next' end If
''----- 文件操作结束' 
'set fso = nothing' 释放内存
'' MsgBox(" 完成!")

需用用到配置文件

config.ini 文件内容:statue=
prefix_name=[320kbp]
suffix_name=[结束]
i=20140100
array=
参数配置使用方法:
  • statue=true 时为增加前缀
  • statue=false 时为增加后缀
  • statue=number 时为增加有序自增数字。
  • statue=array 为调用数组函数
  • statue= 空值时为空,不作处理,退出脚本操作。
  • array=before 时,设置为确认前。
  • array=after 时,设置为确认后。
  • array= 空时,弹出提示信息,退出脚本操作。
  • 好了这篇文章就介绍到这了,主要用到了 FileSystemObject 与 mid 函数

    阿里云 2 核 2G 服务器 3M 带宽 61 元 1 年,有高配

    腾讯云新客低至 82 元 / 年,老客户 99 元 / 年

    代金券:在阿里云专用满减优惠券

    正文完
    星哥玩云-微信公众号
    post-qrcode
     0
    星锅
    版权声明:本站原创文章,由 星锅 于2024-07-25发表,共计5302字。
    转载说明:除特殊说明外本站文章皆由CC-4.0协议发布,转载请注明出处。
    【腾讯云】推广者专属福利,新客户无门槛领取总价值高达2860元代金券,每种代金券限量500张,先到先得。
    阿里云-最新活动爆款每日限量供应
    评论(没有评论)
    验证码
    【腾讯云】云服务器、云数据库、COS、CDN、短信等云产品特惠热卖中