Option Explicit<\/p>\n\n\n\n
‘Example Public Sub Zip(ByVal vFileNames As Variant, ByVal vZipFileName As Variant) ‘Variant \u5fc5\u987b\u7684 Public Sub UnZip(ByVal vZipFile As Variant, ByVal vTargetFolder As Variant) ‘Variant \u5fc5\u987b\u7684
Dim FileNames As Variant ‘Variant \u5fc5\u987b\u7684
Dim ZipFileName As String
sFilter = “All Files(.<\/em>)|.<\/em>“
‘Get the file names
Dim NameGroup As String
NameGroup = DialogOpenFile<\/a>(Me.hwnd, “\u9009\u62e9\u6587\u4ef6”, sFilter, App.Path)
If NameGroup = “” Then Exit Sub
Dim TempArray As Variant
TempArray = Split(NameGroup, vbNullChar)
If UBound(TempArray) – LBound(TempArray) < 3 Then ‘\u5355\u9009\u6216\u591a\u9009\u9009\u4e86\u4e00\u4e2a
ReDim FileNames(0 To 0)
FileNames(0) = TempArray(0)
Else ‘\u591a\u9009\u9009\u4e86\u591a\u4e2a
ReDim FileNames(0 To UBound(TempArray) – LBound(TempArray) – 3)
For I = 0 To UBound(TempArray) – LBound(TempArray) – 3
FileNames(I) = GetFullName<\/a>(TempArray(0), TempArray(I + 1))
Next I
End If
‘Exit if dialog box canceled
If Not IsArray(FileNames) Then Exit Sub
If UBound(FileNames) – LBound(FileNames) < 0 Then Exit Sub
For I = LBound(FileNames) To UBound(FileNames)
If Not FileExist<\/a>(FileNames(I)) Then Exit Sub
Next I
Dim RecommendedName As String
RecommendedName = GetShortPath<\/a>(FileNames(LBound(FileNames)))
sFilter = “Zip File(.zip)|<\/em>.zip”
sTitle = “Save Zip File”
‘\u8c03\u7528\u7a97\u4f53\u53e5\u67c4\uff0cOpen(1)\u8fd8\u662fSave(\u975e1)\uff0c\u6807\u9898\uff0c\u6253\u5f00\u65f6\u81ea\u52a8\u586b\u5165\u7684\u6587\u4ef6\u540d\uff0c\u6a21\u677f\uff0c\u6253\u5f00\u65f6\u81ea\u52a8\u9009\u62e9\u7684\u8def\u5f84\uff0c\u65e0\u6269\u5c55\u540d\u65f6\u81ea\u52a8\u589e\u52a0\u7684\u6269\u5c55\u540d\uff0c\u76ee\u6807\u8def\u5f84
ZipFileName = DialogFile<\/a>(Me.hwnd, 0, sTitle, RecommendedName, sFilter, GetPath<\/a>(FileNames(LBound(FileNames))), “zip”, GetPath(FileNames(LBound(FileNames))), 1)
ZipFileName = Trim(ZipFileName)
If ZipFileName = “” Then Exit Sub
Call Zip(FileNames, ZipFileName)<\/p>\n\n\n\n
On Error Resume Next ‘\u6709\u7684\u7cfb\u7edf\u4e0d\u652f\u6301\u538b\u7f29\u4e0e\u89e3\u538b
Dim I As Integer, J As Integer
If Not IsArray(vFileNames) Then Exit Sub
Dim oShell As Object
‘Create empty Zip File with zip header
Dim ZipFileNumber As Integer
ZipFileNumber = FreeFile
Open vZipFileName For Output As #ZipFileNumber
Print #ZipFileNumber, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #ZipFileNumber
Set oShell = CreateObject(“Shell.Application”) ‘\u57fa\u4e8e shell32.dll
‘Copy the files to the compressed folder
Dim iCount As Integer
iCount = 0
For I = LBound(vFileNames) To UBound(vFileNames)
DoEvents
oShell.NameSpace(vZipFileName).CopyHere vFileNames(I)
‘Debug.Print CStr(I) & Space$(1) & “=” & Space$(1) & vFileNames(I)
‘Keep script waiting until Compressing is done
iCount = iCount + 1
On Error Resume Next
Do Until oShell.NameSpace(vZipFileName).items.Count = iCount
DoEvents
Wait 50
Loop
On Error GoTo 0
‘ShowMsg frmMain, “Zip File” & iCount & Space$(1) & “\/” & Space$(1) & (UBound(vFileNames) – LBound(vFileNames) + 1)
Next I
Set oShell = Nothing
On Error GoTo 0
End Sub<\/p>\n\n\n\n
On Error Resume Next ‘\u6709\u7684\u7cfb\u7edf\u4e0d\u652f\u6301\u538b\u7f29\u4e0e\u89e3\u538b
Dim oShell As Object
‘Copy the zipped files to the newly created folder
Set oShell = CreateObject(“Shell.Application”) ‘\u57fa\u4e8e shell32.dll
oShell.NameSpace(vTargetFolder).CopyHere oShell.NameSpace(vZipFile).items
Set oShell = Nothing
On Error GoTo 0
End Sub<\/p>\n","protected":false},"excerpt":{"rendered":"