复制代码 代码如下: On Error Resume Next Dim objFSO,sourcepath,targetpath,targetfile
Function GetSourceFile(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 targetfile=targetpath & Right(path,Len(path)-Len(sourcepath)) & "" & file.name & ".zip" Set fp=objFSO.OpenTextFile(targetfile,2,True) fp.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18,0) fp.Close oApp.Namespace(targetfile).CopyHere path & "" & file.name WScript.Sleep 1000 Next Set subfolder=folder.subfolders For Each sfolder in subfolder GetSourceFile path & "" & sfolder.name Next End If End Function
Set objFSO=CreateObject("Scripting.FileSystemObject") Set oApp=CreateObject("Shell.Application") sourcepath="C:Documents and SettingsAdministrator桌面Watermarks" targetpath="D: emp" GetSourceFile sourcepath Set objFSO=Nothing Set oApp=Nothing