用vbs实现zip功能的脚本
导读：收集整理的这篇文章主要介绍了用vbs实现zip功能的脚本，觉得挺不错的，现在分享给大家，也给大家做个参考。 压缩： Function fZip(sSourceFolder,sTarge...
收集整理的这篇文章主要介绍了用vbs实现zip功能的脚本，觉得挺不错的，现在分享给大家，也给大家做个参考。 压缩： Function fZip(sSourceFolder,sTargetZIPFile)
'This function will add all of the files in a source folder to a ZIP file
'using Windows' native folder ZIP capabilITy.
Dim oShellApp, oFSO, iErr, sErrSource, sErrDescription
Set oShellApp = CreateObject("Shell.Application")
Set oFSO = CreateObject("Scripting.FileSystemObject")
'The source folder needs to have a \ on the End
If Right(sSourceFolder,1) > "\" Then sSourceFolder = sSourceFolder & "\"
On Error Resume Next
'If a target ZIP exists already, delete it
If oFSO.FileExists(sTargetZIPFile) Then oFSO.DeleteFile sTargetZIPFile,True
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
On Error GoTo 0
If iErr > 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function
End If
On Error Resume Next
'Write the fileheader for a blank zipfile.
oFSO.OPEnTextFile(sTargetZIPFile, 2, True).Write "PK" & Chr(5) & Chr(6) & String(18, Chr(0))
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
On Error GoTo 0
If iErr > 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function
End If
On Error Resume Next
'Start copying files into the zip From the source folder.
oShellApp.namespace(sTargetZIPFile).CopyHere oShellApp.NameSpace(sSourceFolder).Items
iErr = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
On Error GoTo 0
If iErr > 0 Then
fZip = Array(iErr,sErrSource,sErrDescription)
Exit Function
End If
'Because the copying occurs in a separate PRocess, the script will just continue. Run a DO...LOOP to prevent the function
'from exiting until the file is finished zipping.
Do Until oShellApp.NameSpace(sTargetZIPFile).Items.Count = oShellApp.NameSpace(sSourceFolder).Items.Count
WScript.Sleep 1500'如果不成功，增加一下秒数
Loop
fZip = Array(0,"","")
End Function
Call fZip ("C:\vbs","c:\vbs.zip")
解压缩：
Function fUnzip(sZipFile,sTargetFolder)
'Create the Shell.Application object
Dim oShellApp:Set oShellApp = CreateObject("Shell.Application")
'Create the File System object
Dim oFSO:Set oFSO = CreateObject("Scripting.FileSystemObject")
'Create the target folder if it isn't already there
If Not oFSO.FolderExists(sTargetFolder) Then oFSO.CreateFolder sTargetFolder
'Extract the files from the zip into the folder
oShellApp.NameSpace(sTargetFolder).CopyHere oShellApp.NameSpace(sZipFile).Items
'This is a seperate process, so the script would continue even if the unzipping is not done
'To prevent this, we run a DO...LOOP once a second checking to see if the number of files
'in the target folder equals the number of files in the zipfile. If so, we continue.
Do
WScript.Sleep 1000‘有时需要更改
Loop While oFSO.GetFolder(sTargetFolder).Files.Count oShellApp.NameSpace(sZipFile).Items.Count
End Function
声明：本文内容由网友自发贡献，本站不承担相应法律责任。对本内容有异议或投诉，请联系2913721942#qq.com核实处理，我们将尽快回复您，谢谢合作！
若转载请注明出处： 用vbs实现zip功能的脚本
本文地址： https://pptw.com/jishu/609551.html