Question

VBS列出某一类文件

比如 ：
列出2013-05-01 _XXXXXXX.jpg文件
或是ABCXXXXXX.jpg文件
并把他们COPY到另外的目录中。
其中XXXXXX为通配符。

Answer 1

打个补丁防止  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\"),,"复制列表："

返回的即是满足条件的文件名结果，如果遇到重名的情况，自动覆盖。请采纳。

Answer 2

给你写了一个函数 要用通配符的话需要更大量的代码来实现,具体要去查阅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，否则百度会吞掉回车和空格！

 

Answer 3

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