可以将下面的代码放在模块中,然后自己尝试压缩和解压缩文件。
'---------------------------------------------------------------------------------------
' Procedure : PS_Zip
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Zip up a file or folder
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Requires a copy of the PS_Execute() sub
' References: https://docs.microsoft.com/en-us/powershell/module/microsoft.powershell.archive/compress-archive?view=powershell-7.1
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sSrc : The source file or folder to compress/zip
' sDest : The output zip file (fully qualified path and filename)
' sCompressionLvl : Compression level to be used
' NoCompression, Fastest or Optimal
'
' Usage:
' ~~~~~~
' Compress a single file
' PS_Zip("C:\Temp\MonthlyStats.xlsx", "C:\Users\Dev\Desktop\MyZipFile.zip")
' Compress a whole folder
' PS_Zip("C:\Temp\", "C:\Users\Dev\Desktop\MyFolder.zip")
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2021-10-12 Initial Release
'---------------------------------------------------------------------------------------
Public Sub PS_Zip(sSrc As String, _
sDest As String, _
Optional sCompressionLvl As String = "Optimal")
On Error GoTo Error_Handler
Dim sCmd As String
sCmd = "Compress-Archive -LiteralPath '" & sSrc & "' -DestinationPath '" & sDest & _
"' -CompressionLevel " & sCompressionLvl
Call PS_Execute(sCmd)
Error_Handler_Exit:
On Error Resume Next
Exit Sub
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: PS_Zip" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Sub
'---------------------------------------------------------------------------------------
' Procedure : PS_UnZip
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Unzip a file
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Requires a copy of the PS_Execute() function
' References: https://docs.microsoft.com/en-us/powershell/module/microsoft.powershell.archive/expand-archive?view=powershell-7.1
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sSrc : Zip file to unzip/expand
' sDest : Folder where it should be to extracted to
'
' Usage:
' ~~~~~~
' Call PS_UnZip("c:\temp\testing.zip", "c:\temp\exports")
'
' Revision History:
' Rev Date(yyyy-mm-dd) Description
' **************************************************************************************
' 1 2021-10-12 Initial Release
'---------------------------------------------------------------------------------------
Public Sub PS_UnZip(sSrc As String, sDest As String)
On Error GoTo Error_Handler
Dim sCmd As String
sCmd = "Expand-Archive -LiteralPath '" & sSrc & "' -DestinationPath '" & sDest & "'"
Call PS_Execute(sCmd)
Error_Handler_Exit:
On Error Resume Next
Exit Sub
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: PS_UnZip" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Sub
'---------------------------------------------------------------------------------------
' Procedure : PS_Execute
Public Sub PS_Execute(ByVal sPSCmd As String)
'Setup the powershell command properly
sPSCmd = "powershell -command " & sPSCmd
'Execute and capture the returned value
CreateObject("WScript.Shell").Exec (sPSCmd)
End Sub