应用背景:上篇文章说到如果在一项工作中需要自动生成很多文件,然后再压缩 ,然后再进行上传等操作。每次都手动压缩会很麻烦,所以可以加一点代码进行自动压缩Zip文件。
遗留问题:如果只能上传ZIP文件,无法使用rar文件,那么该怎么办呢?
1.在VBE内新建一个模块,插入以下代码。
Sub NewZip(F_Path)'Create empty Zip FileIf Len(Dir(F_Path)) > 0 Then Kill F_PathOpen F_Path For OuF_tput As #1Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)Close #1End 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 WithIf Path_1 = "" Then Exit Submark = InStrRev(Path_1, "\")path_2 = Left(Trim(Path_1), mark) 'For creating ZIP filestrDate = Format(Now, " yy-mmm-dd h-mm-ss")FileNameZip = path_2 & "InputZip " & strDate & ".zip"NewZip (FileNameZip) 'Create a new empty ZipSet oApp = CreateObject("Shell.Application") 'Copy the files to the compressed folderoApp.Namespace(FileNameZip).CopyHere oApp.Namespace(Path_1)On Error Resume NextMsgBox "You can upload the ZIPfile " & FileNameZipEnd Sub
如果觉得《VBA—压缩文件夹成一个ZIP压缩包》对你有帮助,请点赞、收藏,并留下你的观点哦!