VBA处理压缩文件示例_怡然

http://blog.sina.com.cn/u/1070342235

首页博文目录关于我

个人资料

微博

加好友发纸条

写留言加关注

博客等级：
博客积分：

博客访问：
关注人气：
获赠金笔：0支
赠出金笔：0支
荣誉徽章：

正文字体大小：大中小

VBA处理压缩文件示例

(2018-05-23 18:03:37)

标签：

excel

vba

word

代码

分类： VBA专区

在Excel中有时需要对压缩文件进行处理，如从网上下载了一个压缩文件之后(如何通过VBA从网上下载文件)，需要解压到某个文件夹，如Rar和7Zip等压缩文件时需要用到压缩程序的CommandLine语句，这样需要本地机器安装有相应的压缩程序。而对于一般的Zip文件和Cab文件，可以使用Windows自带的压缩程序来处理，VBA通过创建Shell.Application对象来完成处理压缩文件的功能。这里介绍一个VBA处理压缩文件的示例，具体源文件如下：

01.Sub Unzip_Ex()

02. Dim FSO As Object

03. Dim oApp As Object

04. Dim Fname As Variant

05. Dim FileNameFolder As Variant

06. Dim DefPath As String

07. Dim strDate As String

08.

09.

Fname
= Application.GetOpenFilename _

10. (filefilter:=

"Zip
Files (*.zip), *.zip"

, _

11. MultiSelect:=False)

12. If Fname = False Then

13.

'
do nothing

14. Else

15.

'
新文件夹的根目录

16.

'
你也可以使用 DefPath = "C:\Users\HUP\test\"

17.

DefPath
= Application.DefaultFilePath

18. If Right(DefPath, 1) <> "\" Then

19.

DefPath
= DefPath &

"\"

20. End If

21.

22.

'
创建新的文件夹名称

23.

strDate
= Format(Now,

" dd-mm-yy
h-mm-ss"

)

24.

FileNameFolder
= DefPath &

"MyUnzipFolder "

&
strDate &

"\"

25.

26.

'
在DefPath下创建文件夹

27.

MkDir
FileNameFolder

28.

29.

'
将文件解压到新创建的文件夹下

30. Set

oApp =
CreateObject(

"Shell.Application")

31.

32. oApp.Namespace

(FileNameFolder).CopyHere 
oApp.

Namespace(Fname).items

33.

34.

'
如果你只需要解压一个文件，可以使用:

35.

'oApp.Namespace(FileNameFolder).CopyHere
_

36. 'oApp.Namespace(Fname).items.Item("test.txt")

37.

38. MsgBox "You find the files here: "

&
FileNameFolder

39.

40. On Error Resume Next

41. Set

FSO =
CreateObject(

"scripting.filesystemobject")

42.

FSO.deletefolder
Environ(

"Temp") & "\Temporary Directory*", True

43. End If

44.End Sub

阅读┊ 收藏 ┊ 喜欢 ▼ ┊打印┊举报/Report

前一篇：VBA播放多媒体文件的类模块源代码

后一篇：VBA扩展Excel查找功能的4个Lookup函数

新浪BLOG意见反馈留言板　欢迎批评指正