FunctionSelectMuli(byValtext)
onerrorresumenext
Setfso=createobject("scripting.filesystemobject")
SetWshShell=CreateObject("Shell.Application")
dirPath=WshShell.BrowseForFolder(0,text,0,"").items().item().path
Ifright(dirPath,1)<>"\"then
SelectMuli=dirpath&"\"
Endif
Ifdirpath="\"then
SelectMuli="DOCUME~1\Admini~1\桌面\"
Endif
EndFunction
subMain(ByValFolder)
DimMFileSystemObject
DimObjFolder,ObjFolders
SetMFileSystemObject=CreateObject("Scripting.FileSystemObject")
SetObjFolder=MFileSystemObject.GetFolder(Folder)
SetObjFolders=ObjFolder.SubFolders
DimoFiles
SetoFiles=ObjFolder.Files
DimmText
DimmPath
DimmTitle
ForeachFileinoFiles
mText=Right(File,Len(File)-InStr(File,"."))
mText=left(mText,InStrRev(mText,"-")-1)
IfLen(mText)Then
mPath=left(File,InStrRev(File,"\"))
mPath=mPath&mText
If(NotMFileSystemObject.FolderExists(mPath))Then
MFileSystemObject.CreateFolder(mPath)
EndIf
mTitle=Right(File.name,InStrRev(File.Name,"-")+1)
MFileSystemObject.MoveFileFile,mPath&"\"&mTitle
'IfMsgBox(mTitle,vbyesno)=vbyesThen
'ExitSub
'EndIf
EndIf
Next
EndSub
CallMain(SelectMuli("选择目录"))
onerrorresumenext
Setfso=createobject("scripting.filesystemobject")
SetWshShell=CreateObject("Shell.Application")
dirPath=WshShell.BrowseForFolder(0,text,0,"").items().item().path
Ifright(dirPath,1)<>"\"then
SelectMuli=dirpath&"\"
Endif
Ifdirpath="\"then
SelectMuli="DOCUME~1\Admini~1\桌面\"
Endif
EndFunction
subMain(ByValFolder)
DimMFileSystemObject
DimObjFolder,ObjFolders
SetMFileSystemObject=CreateObject("Scripting.FileSystemObject")
SetObjFolder=MFileSystemObject.GetFolder(Folder)
SetObjFolders=ObjFolder.SubFolders
DimoFiles
SetoFiles=ObjFolder.Files
DimmText
DimmPath
DimmTitle
ForeachFileinoFiles
mText=Right(File,Len(File)-InStr(File,"."))
mText=left(mText,InStrRev(mText,"-")-1)
IfLen(mText)Then
mPath=left(File,InStrRev(File,"\"))
mPath=mPath&mText
If(NotMFileSystemObject.FolderExists(mPath))Then
MFileSystemObject.CreateFolder(mPath)
EndIf
mTitle=Right(File.name,InStrRev(File.Name,"-")+1)
MFileSystemObject.MoveFileFile,mPath&"\"&mTitle
'IfMsgBox(mTitle,vbyesno)=vbyesThen
'ExitSub
'EndIf
EndIf
Next
EndSub
CallMain(SelectMuli("选择目录"))