Excel VBA – ZIP Compress a file


I just got a need to compress a file through Excel VBA, here’s what I have found so far from Google.
You will need adding reference to Microsoft Scripting Runtime and Microsoft Shell Controls and Automation (by clicking menu Tools > Reference)


Option Explicit
Option Base 0

Private Declare Sub Sleep Lib “kernel32” (ByVal dwMiliseconds As Long)

Public Sub MakeZip(zipPath As String, filePath As String)
MakeEmptyZip zipPath
AddFile zipPath, filePath
End Sub

Private Sub AddFile(zipPath As String, filePath As String)
Dim sh As Shell32.Shell, fdr As Shell32.Folder, cntItems As Integer ‘cnt = Count
Set sh = CreateObject(“Shell.Application”)
Set fdr = sh.Namespace(zipPath)
cntItems = fdr.Items.Count
fdr.CopyHere filePath, 4 + 16 + 1024
Do
Sleep 1000
Loop Until cntItems < fdr.Items.Count
Set fdr = Nothing
Set sh = Nothing
End Sub

Private Sub MakeEmptyZip(zipPath As String)
Dim fso As Scripting.FileSystemObject
Set fso = CreateObject(“Scripting.FileSystemObject”)
If fso.FileExists(zipPath) Then
fso.DeleteFile zipPath
End If
fso.CreateTextFile(zipPath).Write “PK” & Chr(5) & Chr(6) & String(18, Chr(0))
Set fso = Nothing
End Sub

Private Sub cmdCompress_Click()
Dim sourcePath As String
Dim zippedPath As String

Dim sourceBaseName As String
Dim zippedBaseName As String

Dim sourceFullPath As String
Dim zippedFullPath As String

sourcePath = “C:\Users\Remo\Downloads\”
zippedPath = “C:\Users\Remo\Downloads\”

sourceBaseName = “DATA.MDB”
zippedBaseName = “DATA_Compressed.zip”

sourceFullPath = sourcePath + sourceBaseName
zippedFullPath = zippedPath + zippedBase

Call MakeZip(zippedFullPath, sourceFullPath)

MsgBox (“File ” + sourceBaseName + ” successfully compressed into ” + zippedBaseName)
End Sub

 

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s