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=空时,弹出提示信息,退出脚本操作。

posted @ 2014-08-22 21:06  狂师  阅读(1253)  评论(0编辑  收藏  举报