EXCEL VBA-将工作簿导出为受密码保护的ZIP文件

是否有修改Ron De Bruin的代码将当前工作簿导出到受密码保护的 zip文件。 我已经环顾了相当一段时间,并不知道如何启用这样的选项。

代码在这里: http : //www.rondebruin.nl/win/s7/win001.htm

Sub NewZip(sPath) 'Create empty Zip File 'Changed by keepITcool Dec-12-2005 If Len(Dir(sPath)) > 0 Then Kill sPath Open sPath For Output As #1 Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) Close #1 End Sub Sub Zip_ActiveWorkbook() Dim strDate As String, DefPath As String Dim FileNameZip, FileNameXls Dim oApp As Object Dim FileExtStr As String DefPath = "C:\Users\Ron\test\" '<< Change If Right(DefPath, 1) <> "\" Then DefPath = DefPath & "\" End If 'Create date/time string and the temporary xl* and Zip file name If Val(Application.Version) < 12 Then FileExtStr = ".xls" Else Select Case ActiveWorkbook.FileFormat Case 51: FileExtStr = ".xlsx" Case 52: FileExtStr = ".xlsm" Case 56: FileExtStr = ".xls" Case 50: FileExtStr = ".xlsb" Case Else: FileExtStr = "notknown" End Select If FileExtStr = "notknown" Then MsgBox "Sorry unknown file format" Exit Sub End If End If strDate = Format(Now, " yyyy-mm-dd h-mm-ss") FileNameZip = DefPath & Left(ActiveWorkbook.Name, _ Len(ActiveWorkbook.Name) - Len(FileExtStr)) & strDate & ".zip" FileNameXls = DefPath & Left(ActiveWorkbook.Name, _ Len(ActiveWorkbook.Name) - Len(FileExtStr)) & strDate & FileExtStr If Dir(FileNameZip) = "" And Dir(FileNameXls) = "" Then 'Make copy of the activeworkbook ActiveWorkbook.SaveCopyAs FileNameXls 'Create empty Zip File NewZip (FileNameZip) 'Copy the file in the compressed folder Set oApp = CreateObject("Shell.Application") oApp.Namespace(FileNameZip).CopyHere FileNameXls 'Keep script waiting until Compressing is done On Error Resume Next Do Until oApp.Namespace(FileNameZip).items.Count = 1 Application.Wait (Now + TimeValue("0:00:01")) Loop On Error GoTo 0 'Delete the temporary xls file Kill FileNameXls MsgBox "Your Backup is saved here: " & FileNameZip Else MsgBox "FileNameZip or/and FileNameXls exist" End If End Sub 

我在另一个使用7Zip的网站上find了一个被接受的答案……

 strDestFileName = "c:\temp\TestZipFile.zip" strSourceFileName = "c:\temp\test.pdf" str7ZipPath = "C:\Program Files\7-Zip\7z.exe" strPassword = "MyPassword" strCommand = str7ZipPath & " -p" & strPassword & " a -tzip """ & strDestFileName & """ """ & strSourceFileName & """" Shell strCommand