VBA—压缩文件夹成一个ZIP压缩包

 应用背景：上篇文章说到如果在一项工作中需要自动生成很多文件，然后再压缩 ，然后再进行上传等操作。每次都手动压缩会很麻烦，所以可以加一点代码进行自动压缩Zip文件。

遗留问题：如果只能上传ZIP文件，无法使用rar文件，那么该怎么办呢？

1.在VBE内新建一个模块，插入以下代码。

Sub NewZip(F_Path)
'Create empty Zip File
    If Len(Dir(F_Path)) > 0 Then Kill F_Path
    Open F_Path For OuF_tput As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub

  Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)

这一段貌似是打印机的编码转换，意义不是很清楚；

整个newzip（）函数的功能就是新建一个zip文件，然后再把指定的文件copy到这里来

---

2.然后再写一个子函数，如下所示，即可完成自动压缩ZIP的功能。

Sub ZiP()
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please choose a Job-ID-folder"
If .Show = True Then Path_1 = .SelectedItems(1)
    End With
If Path_1 = "" Then Exit Sub

mark = InStrRev(Path_1, "\")
path_2 = Left(Trim(Path_1), mark)                        'For creating ZIP file

strDate = Format(Now, " yy-mmm-dd h-mm-ss")
FileNameZip = path_2 & "InputZip " & strDate & ".zip"
NewZip (FileNameZip)                                     'Create a new empty Zip
Set oApp = CreateObject("Shell.Application")             'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(Path_1)
On Error Resume Next

MsgBox "You can upload the ZIPfile " & FileNameZip

End Sub