office交流网--QQ交流群号

Access培训群:792054000         Excel免费交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

VBA调用RAR软件实现Excel自动压缩和解压功能

2017-09-08 22:47:00
网络摘录
转贴
14357

Excel VBA高级编程:VBA控制RAR软件实现Excel自动压缩和解压功能

 


网友们可能用过VBA来实现压缩文件,其实就是VBA利用WINRAR的一些命令通过 SHELL这个函数来实现!
先来为大家说说Shell函数:
Shell函数是VB中的内部函数,它负责执行一个可执行文件,返回一个Variant(Double),如果成功的话,代表这个程序的进程ID,若不成功,则会返回0。(这个函数也可以在VBA中使用。)
Shell的语法是:Shell(PathName[,WindowStyle])。
PathName:为必需参数。类型为String,它指出了要执行的程序名,以及任何需要的参数或命令行变量,也可以包括路径名。
WindowStyle:为可选参数。Integer类型,指定在程序运行时窗口的样式。WindowStyle有以下这些值。
常量值 描述
VbHide  0  窗口被隐藏,且焦点会移到隐式窗口。
VbNormalFocus  1  窗口具有焦点,且会还原到它原来的大小和位置。
VbMinimizedFocus  2  窗口会以一个具有焦点的图标来显示(缺省值)。
VbMaximizedFocus  3  窗口是一个具有焦点的最大化窗口。
VbNormalNoFocus  4  窗口会被还原到最近使用的大小和位置,而当前活动的窗口仍然保持活动。
VbMinimizedNoFocus  6  窗口会以一个图标来显示,而当前活动的窗口仍然保持活动。
再介绍下所需要结合运用的WinRar的用法
主要介绍以下如何在WinRar中用命令行来压缩和解压缩文件?
压缩:WINRAR A [-switches] [Files] [@Filelists]
例如你想把Test.mdb压缩到C盘下,可以WINRAR A C:\try.rar C:\Test.mdb
解压缩:如果带目录解压缩
WINRAR X [-switches] [Files] [@Filelists] [destionationfolder]
如果在当前目录解压缩,即解压缩时不写目录名
WINRAR E [-switches] [Files] [@Filelists] [destionationfolder]
例如你想把try.rar解压缩到C盘下,可以WINRAR X C:\try.rar C:\Test.mdb
最后以一个实际例子给大家一个参考
在VBA中新建一个模块,在模块中添加两个子程序压缩文件和解压缩文件。
压缩文件子程序是把文件Test.mdb压缩成try.rar。

Sub 压缩文件()
Dim Rarexe As String 'WINRAR执行文件的位置
Dim Source As String '压缩前的原始文件
Dim Target As String '压缩后的目标文件
Dim FileString As String 'Shell指令中的字符串
Dim Result As Long
Rarexe = "C:\program files\winrar\winrar"
Source = "C:\Test.mdb"
Target = "C:\try.rar"
FileString = Rarexe & " a " & Target & " " & Source
Result = Shell(FileString, vbHide)
End Sub

解压的过程类似,解压缩文件子过程是把try.rar解压生成Test.mdb。在执行了上面的压缩过程后,可以删除文件Test.mdb,来解压缩重新生成Test.mdb。
Sub 解压缩文件()
Dim Rarexe As String 'WINRAR执行文件的位置
Dim Source As String '解压缩前的原始文件
Dim Target As String '解压缩后的目标文件
Dim FileString As String 'Shell指令中的字符串
Dim Result As Long
Rarexe = "C:\program files\winrar\winrar"
Source = "C:\try.rar"
Target = "C:\Test.mdb"
FileString = Rarexe & " X " & Source & " " & Target
Result = Shell(FileString, vbHide)
End Sub



分享