1000字范文,内容丰富有趣,学习的好帮手!
1000字范文 > VBA—压缩文件夹成一个ZIP压缩包

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

时间:2022-04-07 05:03:17

相关推荐

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

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

本内容不代表本网观点和政治立场,如有侵犯你的权益请联系我们处理。
网友评论
网友评论仅供其表达个人看法,并不表明网站立场。