【转载】国外VBA 调用PowerShell压缩和解压缩文件代码-金宇
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-模块/函数/VBA


【转载】国外VBA 调用PowerShell压缩和解压缩文件代码

发表时间:2021/11/2 10:38:08 评论(0) 浏览(2753)  评论 | 加入收藏 | 复制
   
摘 要:VBA 调用PowerShell压缩和解压缩文件代码
正 文:

可以将下面的代码放在模块中,然后自己尝试压缩和解压缩文件。

'---------------------------------------------------------------------------------------
' 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


Access软件网交流QQ群(群号:198465573)
 
 相关文章
分卷压缩文件的解压缩  【网行者  2011/6/5】
使用Powershell命令转换文本文件的编码格式  【健利宝  2019/11/27】
【转载】分享国外甘特图源码Access示例  【金宇  2020/12/8】
【转载】分享国外连续型子窗体代替列表框示例  【金宇  2021/1/2】
【转载】分享国外假日计划示例  【金宇  2021/1/5】
【转载】分享国外甘特图源码示例--根据自己的需求所做的修改  【  2021/2/3】
【转载】源码分享国外拾色器VBA-API 32&64位  【金宇  2021/3/2】
【Access转载】分享国外无须安装/注册,兼容32位和64位的T...  【金宇  2021/5/11】
常见问答
技术分类
相关资源
文章搜索
关于作者

金宇

文章分类

文章存档

友情链接