不使用zip32.dll打包的方法

最新推荐文章于 2022-03-30 10:13:33 发布

Royi666

最新推荐文章于 2022-03-30 10:13:33 发布

阅读量679

点赞数

分类专栏： VBA 文章标签： VBA打包文件

本文链接：https://blog.csdn.net/sunroyi666/article/details/51930710

版权

VBA 专栏收录该内容

1 篇文章 0 订阅

订阅专栏

Dim fso As New Scripting.FileSystemObject
Dim Shell As Object
Dim zFolder As Object
Dim sFolder As Object
Dim zipFile As String
Dim f As Object
Dim FileName As String
Dim sFolderItem As Object
zipFile = "Sample" & ".zip"
FSO.CreateTextFile(zipFile, False).Write "PK"&Chr(5)&Chr(6)&String(18, 0)
Set Shell = CreateObject("Shell.Application")
Set zFolder = Shell.Namespace(FSO.GetAbsolutePathName(zipFile))
set sFolder = Shell.Namespace(FSO.GetAbsolutePathName(sourcePath))

For Each f In FSO.GetFolder(sourcePath).Files
	FileName = FSO.GetFileName(f)
	Set sFolderItem = Shell.Namespace(FSO.GetParentFolderName(FSO.GetAbsolutePathName(f))).ParseName(FileName)
	zFolder.CopyHere sFolderItem
Next

For Each XXX.SubFOlders
	Application.Wait Now+TimeSerial(0, 0, 1)	//如果没有这句话，会生成空白文件
	----------------------------------------------------------------------------------------------------------
	//以下的写法更标准
	Set zFolderItem zFolder.ParseName(FileName)
	If zFolderItem Is Nothing Then
		Count = zFolder.Items.Count
		zFolder.CopyHere sFolderItem
		Do While zFolder.Items().Count = Count
			Application.wait Now + TimeSerial(0, 0, 1)
		Loop
	End If
Next

...