On Error Resume Next Dim objFSO,sourcepath,targetpath
Function GetZipFile(path) Dim file,folder,sfolder,subfolder,files If Not objFSO.FolderExists(path) Then Msgbox "目標文件夾不存在！" Else objFSO.CreateFolder targetpath & Right(path,Len(path)-Len(sourcepath)) Set folder=objFSO.GetFolder(path) Set files=folder.files For Each file in files If StrComp(objFSO.GetExtensionName(file.name),"zip",vbTextCompare)=0 Then objShell.NameSpace(targetpath & Right(path,Len(path)-Len(sourcepath))).CopyHere objShell.NameSpace(path & "/" & file.name).Items(),256 End If Next Set subfolder=folder.subfolders For Each sfolder in subfolder GetZipFile path & "/" & sfolder.name Next End If End Function
Set objFSO=Server.CreateObject("Scripting.FileSystemObject") Set oApp=CreateObject("Shell.Application") sourcepath="C:/zipfiles" targetpath="D:/tmp/" & objFSO.GetFileName(sourcepath) GetZipFile sourcepath Set objFSO=Nothing Set oApp=Nothing
