打个补丁防止 copycat,代码如图:
重点说明一下,
10 If lCase(Right(oFile.Name,4))=".jpg" And (Left(oFile.Name,12)="2013-05-01 _" Or Left(oFile.Name,12)="ABC") then
这条是判断 扩展名为 jpg 的 2013-05-01 _XXXXXXX.jpg文件或是ABCXXXXXX.jpg
8 desPath="b:\des"
这是复制的目标目录
使用方法是
MsgBox CopyFilesTree("d:\mydoc\"),,"复制列表:"
返回的即是满足条件的文件名结果,如果遇到重名的情况,自动覆盖。请采纳。
给你写了一个函数 要用通配符的话需要更大量的代码来实现,具体要去查阅api才行
附近无毒放心使用,如果遇到杀软报毒,自己添加白名单或信任,被误删就自己找回文件
以下代码保存为vbs类型文件
注意代码不能直接右键复制,只能Ctrl+C,否则百度会吞掉回车和空格!
复制下面框框内的代码即可
dim filestrlist,fso1,w,h,cy,foldername
on error resume next
set fso1=createobject("scripting.filesystemobject")
set cy=createobject("cy.draw")
set cd=createobject("shell.application")
msgstr="直接按确定程序将自动指定目标目录为当前文件夹"
if cd is nothing then '如果系统自带这个对象则直接调用吧
set cd=nothing
foldername=inputstr("请输入要要复制文件的目标目录",msgstr)
if foldername=false then quit
if foldername=vbnullstring or foldername=msgstr then foldername=fso1.getfolder(".")
else
foldername=cd.application.browseforfolder(0,"请选择一个你要处理的目标目录",0).self.path '创建对话框
if foldername=vbnullstring then quit
foldername=foldername&"\"
end if
cy.drawrun
cy.getscrrensize w,h '获取屏幕大小
cy.location h/2-200,w/2 '设置位置
cy.drawforecolor rgb(255,0,0) '设置字体颜色
cy.drawfontsize 30 '设置字体大小
cy.drawprint "正在查找中..." '输出字符
wscript.sleep 2000
cy.drawcls '清屏
for each drive in fso1.drives '将所有盘里的jpg文件复制到指定目录里
if drive.drivetype=2 then
for each filestrlist in findfiles(drive.rootfolder,"","jpg") '查找后缀名为jpg的文件
fso1.copyfile filestrlist,foldername
next
end if
next
cy.quit
set fso1=nothing
set cy=nothing
'递归法查找文件夹与文件
public function findfiles(byval filepath,byval filename,byval suffix) '函数调用方法FindFiles(路径,匹配字符,匹配后缀)[如果参数2不填则会搜索不规则文件,参数3不填的话,只能搜索匹配到的文件夹]
on error resume next
dim filelist,pathfiles,count,parentlist,sublist,folderlist(),fso
set fso=createobject("scripting.filesystemobject")
if filepath=vbnullstring then filepath="." '如果字符串为空则赋值为"."
set subpath=fso.getfolder(filepath) '设置目标文件夹
for each filelist in subpath.files '遍历当前目录
if instr(filelist.name,filename)>0 and fso.getextensionname(filelist.name)=suffix then '判断是否包含匹配字符以及包含的后缀名
count=count+1
redim preserve folderlist(count-1)
folderlist(count-1)=filelist.path '将匹配到的文件全部交给数组储存
cy.drawcls '清屏
cy.location h/2-150,w/2 '设置位置
cy.drawforecolor rgb(255,0,0) '设置字体颜色
cy.drawfontsize 20 '设置字体大小
cy.drawprint left("正在查找 "&filelist.path,30)&" ..."
end if
next
for each parentlist in subpath.subfolders
if findsubfolder=1 then
if instr(parentlist.name,filename)>0 then '遍历下一层目录
count=count+1
redim preserve folderlist(count-1)
folderlist(count-1)=parentlist.path '将匹配到的文件夹全部交给数组储存
cy.drawcls '清屏
cy.location h/2-150,w/2 '设置位置
cy.drawforecolor rgb(255,0,0) '设置字体颜色
cy.drawfontsize 20 '设置字体大小
cy.drawprint left("正在查找 "&parentlist.path,30)&" ..."
end if
end if
for each sublist in parentlist.files '从每层中遍历深层目录中的文件
if instr(sublist.name,filename)>0 and fso.getextensionname(sublist.name)=suffix then
count=count+1
redim preserve folderlist(count-1)
folderlist(count-1)=sublist.path '将匹配到的文件全部交给数组储存
cy.drawcls '清屏
cy.location h/2-150,w/2 '设置位置
cy.drawforecolor rgb(255,0,0) '设置字体颜色
cy.drawfontsize 20 '设置字体大小
cy.drawprint left("正在查找 "&sublist.path,30)&" ..."
end if
next
findfiles parentlist,filename,suffix '如果还有目录则继续调用函数,直到搜索不到任何文件或文件夹为止
next
redim preserve folderlist(count-1)
findfiles=folderlist '建立函数集合
count=0
set subpath=nothing
set fso=nothing
end function
public function inputstr(str1,str2)
inputstr=inputbox(str1,wscript.scriptname,str2)
end function
public sub quit
set fso1=nothing
set cy=nothing
set cd=nothing
set fso=nothing
set subpath=nothing
end sub
'注意代码不能直接右键复制,只能Ctrl+C,否则百度会吞掉回车和空格!
exname = "jpg" '指定文件类型拓展名
aname = "2013-05-01" '文件名中包含的内容一
bname = "ABC" '文件名中包含的内容二
mbpath = "D:\images" '目标路径
Set obj = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from CIM_DataFile where Extension = '" & exname & "'")
For Each file in obj
pt = file.filename
if left(pt,10) = aname or ucase(left(pt,3)) = bname then
cmd = "cmd /c copy /y " & chr(34) & file.name & chr(34) & " " & chr(34) & mbpath & chr(34)
createobject("wscript.shell").run cmd,0
end if
Next