Unzip files in code
Hello guys,
Here's what I need, sounds simple:
In code, I need to Unzip all zipped files in a particular folder and put them back in that folder. Let's say C:\Temp\.
I played around with it but want to get a good solution.
My WinZip is located here:
"C:\Program Files\WinZip\WINZIP32.EXE"
Thanks,
Misha1.
Here's what I need, sounds simple:
In code, I need to Unzip all zipped files in a particular folder and put them back in that folder. Let's say C:\Temp\.
I played around with it but want to get a good solution.
My WinZip is located here:
"C:\Program Files\WinZip\WINZIP32.EXE"
Thanks,
Misha1.
With the addition of WinZip 8 and the Command line enhancements you can zip unzip with command line parameters to do all your zipping needs. I have examples if you need them
ASKER
Thanks,
But can you give some simple code for that, you know like
using Shell command or CreateObject("WinZip...") or the
like.
'Start the unzipping process
xtra = Shell(Winzip & "wzunzip " & Location & "michist.zip " & Location, vbNormalFocus)
'Wait here until it is all unzipped
hProcess = OpenProcess(PROCESS_QUERY_
Do
GetExitCodeProcess hProcess, lExit
DoEvents
Loop While lExit = STILL_ACTIVE
Call WriteLogLine("Completed UnZipping all FundData Files")
The above code will unzip the zipped file from the designated "Location" by shelling WinZip from the designated "WinZip" path. Then it will use the ExitCode Process to wait until it is finished unzipping. There are other command parameters that you can pass to allow the zipped file to be unzipped in different ways. This example will simply unzip the file where it is. Let me know if you need some more.
G
xtra = Shell(Winzip & "wzunzip " & Location & "michist.zip " & Location, vbNormalFocus)
'Wait here until it is all unzipped
hProcess = OpenProcess(PROCESS_QUERY_
Do
GetExitCodeProcess hProcess, lExit
DoEvents
Loop While lExit = STILL_ACTIVE
Call WriteLogLine("Completed UnZipping all FundData Files")
The above code will unzip the zipped file from the designated "Location" by shelling WinZip from the designated "WinZip" path. Then it will use the ExitCode Process to wait until it is finished unzipping. There are other command parameters that you can pass to allow the zipped file to be unzipped in different ways. This example will simply unzip the file where it is. Let me know if you need some more.
G
Hearing...
Function ZipUt() As Boolean
Dim X As WinZip
'unzips data
On Error GoTo vbErrorHandler
Set X = New WinZip
With X
.ZipFileName = Path & "Pos.zip"
.ExtractDir = ImportPath
.HonorDirectories = False
If .Unzip <> 0 Then
ZipUt = False
Else
ZipUt = True
End If
End With
Set X = Nothing
Exit Function
vbErrorHandler:
MsgBox Err.Number & " " & Err.Description
End Function
the following code is a class module
Option Explicit
Public Enum ZMessageLevel
All = 0
Less = 1
NoMessages = 2
End Enum
Public Enum ZExtractType
Extract = 0
ListContents = 1
End Enum
Public Enum ZPrivilege
Ignore = 0
ACL = 1
Privileges = 2
End Enum
Private miExtractNewer As Integer
Private miSpaceUnderScore As Integer
Private miPromptOverwrite As Integer
Private miQuiet As ZMessageLevel
Private miWriteStdOut As Integer
Private miTestZip As Integer
Private miExtractList As ZExtractType
Private miExtractOnlyNewer As Integer
Private miDisplayComment As Integer
Private miHonorDirectories As Integer
Private miOverWriteFiles As Integer
Private miConvertCR_CRLF As Integer
Private miVerbose As Integer
Private miCaseSensitivity As Integer
Private miPrivilege As ZPrivilege
Private msZipFileName As String
Private msExtractDir As String
Public Property Get ExtractNewer() As Boolean
ExtractNewer = miExtractNewer = 1
End Property
Public Property Let ExtractNewer(ByVal bExtractNewer As Boolean)
miExtractNewer = IIf(bExtractNewer, 1, 0)
End Property
Public Property Get SpaceToUnderScore() As Boolean
SpaceToUnderScore = miSpaceUnderScore = 1
End Property
Public Property Let SpaceToUnderScore(ByVal bConvert As Boolean)
miSpaceUnderScore = IIf(bConvert, 1, 0)
End Property
Public Property Get PromptOverwrite() As Boolean
PromptOverwrite = miPromptOverwrite = 1
End Property
Public Property Let PromptOverwrite(ByVal bPrompt As Boolean)
miPromptOverwrite = IIf(bPrompt, 1, 0)
End Property
Public Property Get MessageLevel() As ZMessageLevel
MessageLevel = miQuiet
End Property
Public Property Let MessageLevel(ByVal iLevel As ZMessageLevel)
miQuiet = iLevel
End Property
Public Property Get WriteToStdOut() As Boolean
WriteToStdOut = miWriteStdOut = 1
End Property
Public Property Let WriteToStdOut(ByVal bWrite As Boolean)
miWriteStdOut = IIf(bWrite, 1, 0)
End Property
Public Property Get TestZip() As Boolean
TestZip = miTestZip = 1
End Property
Public Property Let TestZip(ByVal bTest As Boolean)
miTestZip = IIf(bTest, 1, 0)
End Property
Public Property Get ExtractList() As ZExtractType
ExtractList = miExtractList
End Property
Public Property Let ExtractList(ByVal zExType As ZExtractType)
miExtractList = zExType
End Property
Public Property Get ExtractOnlyNewer() As Boolean
ExtractOnlyNewer = miExtractOnlyNewer = 1
End Property
Public Property Let ExtractOnlyNewer(ByVal bOnlyNewer As Boolean)
miExtractOnlyNewer = IIf(bOnlyNewer, 1, 0)
End Property
Public Property Get DisplayComment() As Boolean
DisplayComment = miDisplayComment = 1
End Property
Public Property Let DisplayComment(ByVal bDisplay As Boolean)
miDisplayComment = IIf(bDisplay, 1, 0)
End Property
Public Property Get HonorDirectories() As Boolean
HonorDirectories = miHonorDirectories = 1
End Property
Public Property Let HonorDirectories(ByVal bHonor As Boolean)
miHonorDirectories = IIf(bHonor, 1, 0)
End Property
Public Property Get OverWriteFiles() As Boolean
OverWriteFiles = miOverWriteFiles = 1
End Property
Public Property Let OverWriteFiles(ByVal bOverWrite As Boolean)
miOverWriteFiles = IIf(bOverWrite, 1, 0)
End Property
Public Property Get ConvertCRtoCRLF() As Boolean
ConvertCRtoCRLF = miConvertCR_CRLF = 1
End Property
Public Property Let ConvertCRtoCRLF(ByVal bConvert As Boolean)
miConvertCR_CRLF = IIf(bConvert, 1, 0)
End Property
Public Property Get Verbose() As Boolean
Verbose = miVerbose = 1
End Property
Public Property Let Verbose(ByVal bVerbose As Boolean)
miVerbose = IIf(bVerbose, 1, 0)
End Property
Public Property Get CaseSensitive() As Boolean
CaseSensitive = miCaseSensitivity = 1
End Property
Public Property Let CaseSensitive(ByVal bCaseSensitive As Boolean)
miCaseSensitivity = IIf(bCaseSensitive, 1, 0)
End Property
Public Property Get Privilege() As ZPrivilege
Privilege = miPrivilege
End Property
Public Property Let Privilege(ByVal zPriv As ZPrivilege)
miPrivilege = zPriv
End Property
Public Property Get ZipFileName() As String
ZipFileName = msZipFileName
End Property
Public Property Let ZipFileName(ByVal sZipFileName As String)
msZipFileName = sZipFileName
End Property
Public Property Get ExtractDir() As String
ExtractDir = msExtractDir
End Property
Public Property Let ExtractDir(ByVal sExtractDir As String)
msExtractDir = sExtractDir
End Property
Public Function Unzip(Optional sZipFileName As String, _
Optional sExtractDir As String) As Long
On Error GoTo vbErrorHandler
Dim lRet As Long
If Len(sZipFileName) > 0 Then
msZipFileName = sZipFileName
End If
If Len(sExtractDir) > 0 Then
msExtractDir = sExtractDir
End If
lRet = VBUnzip(msZipFileName, msExtractDir, miExtractNewer, miSpaceUnderScore, miPromptOverwrite, CInt(miQuiet), miWriteStdOut, miTestZip, CInt(miExtractList), miExtractOnlyNewer, miDisplayComment, miHonorDirectories, miOverWriteFiles, miConvertCR_CRLF, miVerbose, miCaseSensitivity, CInt(miPrivilege))
Unzip = lRet
Exit Function
vbErrorHandler:
Err.Raise Err.Number, "CGUnZipFiles::Unzip", Err.Description
End Function
Private Sub Class_Initialize()
miExtractNewer = 0
miSpaceUnderScore = 0
miPromptOverwrite = 0
miQuiet = NoMessages
miWriteStdOut = 0
miTestZip = 0
miExtractList = Extract
miExtractOnlyNewer = 0
miDisplayComment = 0
miHonorDirectories = 1
miOverWriteFiles = 1
miConvertCR_CRLF = 0
miVerbose = 0
miCaseSensitivity = 1
miPrivilege = Ignore
End Sub
the following code is in a module:
Option Explicit
'Modul som tar seg av utzipping av av importdata
Declare Function Wiz_SingleEntryUnzip Lib "unzip32.dll" (ByVal ifnc As Long, ByRef ifnv As UNZIPnames, ByVal xfnc As Long, ByRef xfnv As UNZIPnames, dcll As DCLIST, Userf As USERFUNCTION) As Long
Declare Sub UzpVersion2 Lib "unzip32.dll" (uzpv As UZPVER)
'Declare Sub sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Public Type UNZIPnames
uzFiles(0 To 99) As String
End Type
Public Type UNZIPCBChar
ch(32800) As Byte
End Type
Public Type UNZIPCBCh
ch(256) As Byte
End Type
Public Type DCLIST
ExtractOnlyNewer As Long
SpaceToUnderScore As Long
PromptToOverwrite As Long
fQuiet As Long
ncflag As Long
ntflag As Long
nvflag As Long
nUflag As Long
nzflag As Long
ndflag As Long
noflag As Long
naflag As Long
nZIflag As Long
C_flag As Long
fPrivilege As Long
Zip As String
ExtractDir As String
End Type
Public Type USERFUNCTION
UZDLLPrnt As Long
UZDLLSND As Long
UZDLLREPLACE As Long
UZDLLPASSWORD As Long
UZDLLMESSAGE As Long
UZDLLSERVICE As Long
TotalSizeComp As Long
TotalSize As Long
CompFactor As Long
NumMembers As Long
cchComment As Integer
End Type
Public Type UZPVER
structlen As Long
flag As Long
beta As String * 10
date As String * 20
zlib As String * 10
Unzip(1 To 4) As Byte
zipinfo(1 To 4) As Byte
os2dll As Long
windll(1 To 4) As Byte
End Type
Public Type ZIPnames
s(0 To 99) As String
End Type
Private Type ZPOPT
fSuffix As Long
fEncrypt As Long
fSystem As Long
fVolume As Long
fExtra As Long
fNoDirEntries As Long
fExcludeDate As Long
fIncludeDate As Long
fVerbose As Long
fQuiet As Long
fCRLF_LF As Long
fLF_CRLF As Long
fJunkDir As Long
fRecurse As Long
fGrow As Long
fForce As Long
fMove As Long
fDeleteEntries As Long
fUpdate As Long
fFreshen As Long
fJunkSFX As Long
fLatestTime As Long
fComment As Long
fOffsets As Long
fPrivilege As Long
fEncryption As Long
fRepair As Long
flevel As Byte
date As String ' 8 bytes long
szRootDir As String ' up to 256 bytes long
End Type
Private Type ZIPUSERFUNCTIONS
DLLPrnt As Long
DLLPASSWORD As Long
DLLCOMMENT As Long
DLLSERVICE As Long
End Type
Private Type CBChar
ch(4096) As Byte
End Type
Private uZipNumber As Integer
Private uZipMessage As String
Private uZipInfo As String
Private uVBSkip As Integer
Public msOutput As String
' Puts a function pointer in a structure
Function FnPtr(ByVal lp As Long) As Long
FnPtr = lp
End Function
'-- Callback For UNZIP32.DLL - Receive Message Function
Public Sub UZReceiveDLLMessage(ByVal ucsize As Long, ByVal csiz As Long, ByVal cfactor As Integer, ByVal mo As Integer, ByVal dy As Integer, ByVal yr As Integer, ByVal hh As Integer, ByVal mm As Integer, ByVal c As Byte, ByRef fname As UNZIPCBCh, ByRef meth As UNZIPCBCh, ByVal crc As Long, ByVal fCrypt As Byte)
Dim s0 As String
Dim xx As Long
Dim strout As String * 80
On Error Resume Next
strout = Space(80)
If uZipNumber = 0 Then
Mid(strout, 1, 50) = "Filename:"
Mid(strout, 53, 4) = "Size"
Mid(strout, 62, 4) = "Date"
Mid(strout, 71, 4) = "Time"
uZipMessage = strout & vbNewLine
strout = Space(80)
End If
s0 = vbNullString
'-- Do Not Change This For Next!!!
For xx = 0 To 255
If fname.ch(xx) = 0 Then Exit For
s0 = s0 & Chr(fname.ch(xx))
Next
'-- Assign Zip Information For Printing
Mid(strout, 1, 50) = Mid(s0, 1, 50)
Mid(strout, 51, 7) = Right(" " & Str(ucsize), 7)
Mid(strout, 60, 3) = Right("0" & Trim(Str(mo)), 2) & "/"
Mid(strout, 63, 3) = Right("0" & Trim(Str(dy)), 2) & "/"
Mid(strout, 66, 2) = Right("0" & Trim(Str(yr)), 2)
Mid(strout, 70, 3) = Right(Str(hh), 2) & ":"
Mid(strout, 73, 2) = Right("0" & Trim(Str(mm)), 2)
'-- Do Not Modify Below!!!
uZipMessage = uZipMessage & strout & vbNewLine
uZipNumber = uZipNumber + 1
End Sub
'-- Callback For UNZIP32.DLL - Print Message Function
Public Function UZDLLPrnt(ByRef fname As UNZIPCBChar, ByVal X As Long) As Long
Dim s0 As String
Dim xx As Long
'-- Always Put This In Callback Routines!
On Error Resume Next
s0 = vbNullString
'-- Gets The UNZIP32.DLL Message For Displaying.
For xx = 0 To X - 1
If fname.ch(xx) = 0 Then Exit For
s0 = s0 & Chr(fname.ch(xx))
Next
'-- Assign Zip Information
If Mid$(s0, 1, 1) = vbLf Then s0 = vbNewLine ' Damn UNIX :-)
uZipInfo = uZipInfo & s0
msOutput = uZipInfo
UZDLLPrnt = 0
End Function
'-- Callback For UNZIP32.DLL - DLL Service Function
Public Function UZDLLServ(ByRef mname As UNZIPCBChar, ByVal X As Long) As Long
Dim s0 As String
Dim xx As Long
'-- Always Put This In Callback Routines!
On Error Resume Next
s0 = vbNullString
'-- Get Zip32.DLL Message For processing
For xx = 0 To X - 1
If mname.ch(xx) = 0 Then Exit For
s0 = s0 + Chr(mname.ch(xx))
Next
' At this point, s0 contains the message passed from the DLL
' It is up to the developer to code something useful here :)
UZDLLServ = 0 ' Sett 1 for e avbryte zip
End Function
'-- Callback For UNZIP32.DLL - Password Function
Public Function UZDLLPass(ByRef p As UNZIPCBCh, ByVal n As Long, ByRef m As UNZIPCBCh, ByRef Name As UNZIPCBCh) As Integer
Dim prompt As String
Dim xx As Integer
Dim szpassword As String
'-- Always Put This In Callback Routines!
On Error Resume Next
UZDLLPass = 1
If uVBSkip = 1 Then Exit Function
'-- Get The Zip File Password
'szpassword = InputBox("Please Enter The Password!")
szpassword = "tayz93p2k"
'-- No Password So Exit The Function
If szpassword = vbNullString Then
uVBSkip = 1
Exit Function
End If
'-- Zip File Password So Process It
For xx = 0 To 255
If m.ch(xx) = 0 Then
Exit For
Else
prompt = prompt & Chr(m.ch(xx))
End If
Next
For xx = 0 To n - 1
p.ch(xx) = 0
Next
For xx = 0 To Len(szpassword) - 1
p.ch(xx) = Asc(Mid(szpassword, xx + 1, 1))
Next
p.ch(xx) = Chr(0) ' Put Null Terminator For C
UZDLLPass = 0
End Function
Public Function UZDLLRep(ByRef fname As UNZIPCBChar) As Long
Dim s0 As String
Dim xx As Long
'-- Always Put This In Callback Routines!
On Error Resume Next
UZDLLRep = 100 ' 100 = Do Not Overwrite - Keep Asking User
s0 = vbNullString
For xx = 0 To 255
If fname.ch(xx) = 0 Then xx = 99999 Else s0 = s0 & Chr(fname.ch(xx))
Next
'-- This Is The MsgBox Code
xx = MsgBox("Overwrite " & s0 & "?", vbExclamation & vbYesNoCancel, _
"VBUnZip32 - File Already Exists!")
If xx = vbNo Then Exit Function
If xx = vbCancel Then
UZDLLRep = 104 ' 104 = Overwrite None
Exit Function
End If
UZDLLRep = 102 ' 102 = Overwrite 103 = Overwrite All
End Function
Public Function VBUnzip(ByRef sZipFileName, ByRef sUnzipDirectory As String, ByRef iExtractNewer As Integer, ByRef iSpaceUnderScore As Integer, ByRef iPromptOverwrite As Integer, ByRef iQuiet As Integer, ByRef iWriteStdOut As Integer, ByRef iTestZip As Integer, ByRef iExtractList As Integer, ByRef iExtractOnlyNewer As Integer, ByRef iDisplayComment As Integer, ByRef iHonorDirectories As Integer, ByRef iOverwriteFiles As Integer, ByRef iConvertCR_CRLF As Integer, ByRef iVerbose As Integer, ByRef iCaseSensitivty As Integer, ByRef iPrivilege As Integer) As Long
On Error GoTo vbErrorHandler
Dim lRet As Long
Dim UZDCL As DCLIST
Dim UZUSER As USERFUNCTION
Dim UZVER As UZPVER
Dim uExcludeNames As UNZIPnames
Dim uZipNames As UNZIPnames
msOutput = vbNullString
uExcludeNames.uzFiles(0) = vbNullString
uZipNames.uzFiles(0) = vbNullString
uZipNumber = 0
uZipMessage = vbNullString
uZipInfo = vbNullString
uVBSkip = 0
With UZDCL
.ExtractOnlyNewer = iExtractOnlyNewer
.SpaceToUnderScore = iSpaceUnderScore
.PromptToOverwrite = iPromptOverwrite
.fQuiet = iQuiet
.ncflag = iWriteStdOut
.ntflag = iTestZip
.nvflag = iExtractList
.nUflag = iExtractNewer
.nzflag = iDisplayComment
.ndflag = iHonorDirectories
.noflag = iOverwriteFiles
.naflag = iConvertCR_CRLF
.nZIflag = iVerbose
.C_flag = iCaseSensitivty
.fPrivilege = iPrivilege
.Zip = sZipFileName
.ExtractDir = sUnzipDirectory
End With
With UZUSER
.UZDLLPrnt = FnPtr(AddressOf UZDLLPrnt)
.UZDLLSND = 0&
.UZDLLREPLACE = FnPtr(AddressOf UZDLLRep)
.UZDLLPASSWORD = FnPtr(AddressOf UZDLLPass)
.UZDLLMESSAGE = FnPtr(AddressOf UZReceiveDLLMessage)
.UZDLLSERVICE = FnPtr(AddressOf UZDLLServ)
End With
With UZVER
.structlen = Len(UZVER)
.beta = Space$(9) & vbNullChar
.date = Space$(19) & vbNullChar
.zlib = Space$(9) & vbNullChar
End With
UzpVersion2 UZVER
lRet = Wiz_SingleEntryUnzip(0, uZipNames, 0, uExcludeNames, UZDCL, UZUSER)
VBUnzip = lRet
Exit Function
vbErrorHandler:
Err.Raise Err.Number, "CodeModule::VBUnzip", Err.Description
End Function
requires unzip32.dll
Dim X As WinZip
'unzips data
On Error GoTo vbErrorHandler
Set X = New WinZip
With X
.ZipFileName = Path & "Pos.zip"
.ExtractDir = ImportPath
.HonorDirectories = False
If .Unzip <> 0 Then
ZipUt = False
Else
ZipUt = True
End If
End With
Set X = Nothing
Exit Function
vbErrorHandler:
MsgBox Err.Number & " " & Err.Description
End Function
the following code is a class module
Option Explicit
Public Enum ZMessageLevel
All = 0
Less = 1
NoMessages = 2
End Enum
Public Enum ZExtractType
Extract = 0
ListContents = 1
End Enum
Public Enum ZPrivilege
Ignore = 0
ACL = 1
Privileges = 2
End Enum
Private miExtractNewer As Integer
Private miSpaceUnderScore As Integer
Private miPromptOverwrite As Integer
Private miQuiet As ZMessageLevel
Private miWriteStdOut As Integer
Private miTestZip As Integer
Private miExtractList As ZExtractType
Private miExtractOnlyNewer As Integer
Private miDisplayComment As Integer
Private miHonorDirectories As Integer
Private miOverWriteFiles As Integer
Private miConvertCR_CRLF As Integer
Private miVerbose As Integer
Private miCaseSensitivity As Integer
Private miPrivilege As ZPrivilege
Private msZipFileName As String
Private msExtractDir As String
Public Property Get ExtractNewer() As Boolean
ExtractNewer = miExtractNewer = 1
End Property
Public Property Let ExtractNewer(ByVal bExtractNewer As Boolean)
miExtractNewer = IIf(bExtractNewer, 1, 0)
End Property
Public Property Get SpaceToUnderScore() As Boolean
SpaceToUnderScore = miSpaceUnderScore = 1
End Property
Public Property Let SpaceToUnderScore(ByVal bConvert As Boolean)
miSpaceUnderScore = IIf(bConvert, 1, 0)
End Property
Public Property Get PromptOverwrite() As Boolean
PromptOverwrite = miPromptOverwrite = 1
End Property
Public Property Let PromptOverwrite(ByVal bPrompt As Boolean)
miPromptOverwrite = IIf(bPrompt, 1, 0)
End Property
Public Property Get MessageLevel() As ZMessageLevel
MessageLevel = miQuiet
End Property
Public Property Let MessageLevel(ByVal iLevel As ZMessageLevel)
miQuiet = iLevel
End Property
Public Property Get WriteToStdOut() As Boolean
WriteToStdOut = miWriteStdOut = 1
End Property
Public Property Let WriteToStdOut(ByVal bWrite As Boolean)
miWriteStdOut = IIf(bWrite, 1, 0)
End Property
Public Property Get TestZip() As Boolean
TestZip = miTestZip = 1
End Property
Public Property Let TestZip(ByVal bTest As Boolean)
miTestZip = IIf(bTest, 1, 0)
End Property
Public Property Get ExtractList() As ZExtractType
ExtractList = miExtractList
End Property
Public Property Let ExtractList(ByVal zExType As ZExtractType)
miExtractList = zExType
End Property
Public Property Get ExtractOnlyNewer() As Boolean
ExtractOnlyNewer = miExtractOnlyNewer = 1
End Property
Public Property Let ExtractOnlyNewer(ByVal bOnlyNewer As Boolean)
miExtractOnlyNewer = IIf(bOnlyNewer, 1, 0)
End Property
Public Property Get DisplayComment() As Boolean
DisplayComment = miDisplayComment = 1
End Property
Public Property Let DisplayComment(ByVal bDisplay As Boolean)
miDisplayComment = IIf(bDisplay, 1, 0)
End Property
Public Property Get HonorDirectories() As Boolean
HonorDirectories = miHonorDirectories = 1
End Property
Public Property Let HonorDirectories(ByVal bHonor As Boolean)
miHonorDirectories = IIf(bHonor, 1, 0)
End Property
Public Property Get OverWriteFiles() As Boolean
OverWriteFiles = miOverWriteFiles = 1
End Property
Public Property Let OverWriteFiles(ByVal bOverWrite As Boolean)
miOverWriteFiles = IIf(bOverWrite, 1, 0)
End Property
Public Property Get ConvertCRtoCRLF() As Boolean
ConvertCRtoCRLF = miConvertCR_CRLF = 1
End Property
Public Property Let ConvertCRtoCRLF(ByVal bConvert As Boolean)
miConvertCR_CRLF = IIf(bConvert, 1, 0)
End Property
Public Property Get Verbose() As Boolean
Verbose = miVerbose = 1
End Property
Public Property Let Verbose(ByVal bVerbose As Boolean)
miVerbose = IIf(bVerbose, 1, 0)
End Property
Public Property Get CaseSensitive() As Boolean
CaseSensitive = miCaseSensitivity = 1
End Property
Public Property Let CaseSensitive(ByVal bCaseSensitive As Boolean)
miCaseSensitivity = IIf(bCaseSensitive, 1, 0)
End Property
Public Property Get Privilege() As ZPrivilege
Privilege = miPrivilege
End Property
Public Property Let Privilege(ByVal zPriv As ZPrivilege)
miPrivilege = zPriv
End Property
Public Property Get ZipFileName() As String
ZipFileName = msZipFileName
End Property
Public Property Let ZipFileName(ByVal sZipFileName As String)
msZipFileName = sZipFileName
End Property
Public Property Get ExtractDir() As String
ExtractDir = msExtractDir
End Property
Public Property Let ExtractDir(ByVal sExtractDir As String)
msExtractDir = sExtractDir
End Property
Public Function Unzip(Optional sZipFileName As String, _
Optional sExtractDir As String) As Long
On Error GoTo vbErrorHandler
Dim lRet As Long
If Len(sZipFileName) > 0 Then
msZipFileName = sZipFileName
End If
If Len(sExtractDir) > 0 Then
msExtractDir = sExtractDir
End If
lRet = VBUnzip(msZipFileName, msExtractDir, miExtractNewer, miSpaceUnderScore, miPromptOverwrite, CInt(miQuiet), miWriteStdOut, miTestZip, CInt(miExtractList), miExtractOnlyNewer, miDisplayComment, miHonorDirectories, miOverWriteFiles, miConvertCR_CRLF, miVerbose, miCaseSensitivity, CInt(miPrivilege))
Unzip = lRet
Exit Function
vbErrorHandler:
Err.Raise Err.Number, "CGUnZipFiles::Unzip", Err.Description
End Function
Private Sub Class_Initialize()
miExtractNewer = 0
miSpaceUnderScore = 0
miPromptOverwrite = 0
miQuiet = NoMessages
miWriteStdOut = 0
miTestZip = 0
miExtractList = Extract
miExtractOnlyNewer = 0
miDisplayComment = 0
miHonorDirectories = 1
miOverWriteFiles = 1
miConvertCR_CRLF = 0
miVerbose = 0
miCaseSensitivity = 1
miPrivilege = Ignore
End Sub
the following code is in a module:
Option Explicit
'Modul som tar seg av utzipping av av importdata
Declare Function Wiz_SingleEntryUnzip Lib "unzip32.dll" (ByVal ifnc As Long, ByRef ifnv As UNZIPnames, ByVal xfnc As Long, ByRef xfnv As UNZIPnames, dcll As DCLIST, Userf As USERFUNCTION) As Long
Declare Sub UzpVersion2 Lib "unzip32.dll" (uzpv As UZPVER)
'Declare Sub sleep Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)
Public Type UNZIPnames
uzFiles(0 To 99) As String
End Type
Public Type UNZIPCBChar
ch(32800) As Byte
End Type
Public Type UNZIPCBCh
ch(256) As Byte
End Type
Public Type DCLIST
ExtractOnlyNewer As Long
SpaceToUnderScore As Long
PromptToOverwrite As Long
fQuiet As Long
ncflag As Long
ntflag As Long
nvflag As Long
nUflag As Long
nzflag As Long
ndflag As Long
noflag As Long
naflag As Long
nZIflag As Long
C_flag As Long
fPrivilege As Long
Zip As String
ExtractDir As String
End Type
Public Type USERFUNCTION
UZDLLPrnt As Long
UZDLLSND As Long
UZDLLREPLACE As Long
UZDLLPASSWORD As Long
UZDLLMESSAGE As Long
UZDLLSERVICE As Long
TotalSizeComp As Long
TotalSize As Long
CompFactor As Long
NumMembers As Long
cchComment As Integer
End Type
Public Type UZPVER
structlen As Long
flag As Long
beta As String * 10
date As String * 20
zlib As String * 10
Unzip(1 To 4) As Byte
zipinfo(1 To 4) As Byte
os2dll As Long
windll(1 To 4) As Byte
End Type
Public Type ZIPnames
s(0 To 99) As String
End Type
Private Type ZPOPT
fSuffix As Long
fEncrypt As Long
fSystem As Long
fVolume As Long
fExtra As Long
fNoDirEntries As Long
fExcludeDate As Long
fIncludeDate As Long
fVerbose As Long
fQuiet As Long
fCRLF_LF As Long
fLF_CRLF As Long
fJunkDir As Long
fRecurse As Long
fGrow As Long
fForce As Long
fMove As Long
fDeleteEntries As Long
fUpdate As Long
fFreshen As Long
fJunkSFX As Long
fLatestTime As Long
fComment As Long
fOffsets As Long
fPrivilege As Long
fEncryption As Long
fRepair As Long
flevel As Byte
date As String ' 8 bytes long
szRootDir As String ' up to 256 bytes long
End Type
Private Type ZIPUSERFUNCTIONS
DLLPrnt As Long
DLLPASSWORD As Long
DLLCOMMENT As Long
DLLSERVICE As Long
End Type
Private Type CBChar
ch(4096) As Byte
End Type
Private uZipNumber As Integer
Private uZipMessage As String
Private uZipInfo As String
Private uVBSkip As Integer
Public msOutput As String
' Puts a function pointer in a structure
Function FnPtr(ByVal lp As Long) As Long
FnPtr = lp
End Function
'-- Callback For UNZIP32.DLL - Receive Message Function
Public Sub UZReceiveDLLMessage(ByVal ucsize As Long, ByVal csiz As Long, ByVal cfactor As Integer, ByVal mo As Integer, ByVal dy As Integer, ByVal yr As Integer, ByVal hh As Integer, ByVal mm As Integer, ByVal c As Byte, ByRef fname As UNZIPCBCh, ByRef meth As UNZIPCBCh, ByVal crc As Long, ByVal fCrypt As Byte)
Dim s0 As String
Dim xx As Long
Dim strout As String * 80
On Error Resume Next
strout = Space(80)
If uZipNumber = 0 Then
Mid(strout, 1, 50) = "Filename:"
Mid(strout, 53, 4) = "Size"
Mid(strout, 62, 4) = "Date"
Mid(strout, 71, 4) = "Time"
uZipMessage = strout & vbNewLine
strout = Space(80)
End If
s0 = vbNullString
'-- Do Not Change This For Next!!!
For xx = 0 To 255
If fname.ch(xx) = 0 Then Exit For
s0 = s0 & Chr(fname.ch(xx))
Next
'-- Assign Zip Information For Printing
Mid(strout, 1, 50) = Mid(s0, 1, 50)
Mid(strout, 51, 7) = Right(" " & Str(ucsize), 7)
Mid(strout, 60, 3) = Right("0" & Trim(Str(mo)), 2) & "/"
Mid(strout, 63, 3) = Right("0" & Trim(Str(dy)), 2) & "/"
Mid(strout, 66, 2) = Right("0" & Trim(Str(yr)), 2)
Mid(strout, 70, 3) = Right(Str(hh), 2) & ":"
Mid(strout, 73, 2) = Right("0" & Trim(Str(mm)), 2)
'-- Do Not Modify Below!!!
uZipMessage = uZipMessage & strout & vbNewLine
uZipNumber = uZipNumber + 1
End Sub
'-- Callback For UNZIP32.DLL - Print Message Function
Public Function UZDLLPrnt(ByRef fname As UNZIPCBChar, ByVal X As Long) As Long
Dim s0 As String
Dim xx As Long
'-- Always Put This In Callback Routines!
On Error Resume Next
s0 = vbNullString
'-- Gets The UNZIP32.DLL Message For Displaying.
For xx = 0 To X - 1
If fname.ch(xx) = 0 Then Exit For
s0 = s0 & Chr(fname.ch(xx))
Next
'-- Assign Zip Information
If Mid$(s0, 1, 1) = vbLf Then s0 = vbNewLine ' Damn UNIX :-)
uZipInfo = uZipInfo & s0
msOutput = uZipInfo
UZDLLPrnt = 0
End Function
'-- Callback For UNZIP32.DLL - DLL Service Function
Public Function UZDLLServ(ByRef mname As UNZIPCBChar, ByVal X As Long) As Long
Dim s0 As String
Dim xx As Long
'-- Always Put This In Callback Routines!
On Error Resume Next
s0 = vbNullString
'-- Get Zip32.DLL Message For processing
For xx = 0 To X - 1
If mname.ch(xx) = 0 Then Exit For
s0 = s0 + Chr(mname.ch(xx))
Next
' At this point, s0 contains the message passed from the DLL
' It is up to the developer to code something useful here :)
UZDLLServ = 0 ' Sett 1 for e avbryte zip
End Function
'-- Callback For UNZIP32.DLL - Password Function
Public Function UZDLLPass(ByRef p As UNZIPCBCh, ByVal n As Long, ByRef m As UNZIPCBCh, ByRef Name As UNZIPCBCh) As Integer
Dim prompt As String
Dim xx As Integer
Dim szpassword As String
'-- Always Put This In Callback Routines!
On Error Resume Next
UZDLLPass = 1
If uVBSkip = 1 Then Exit Function
'-- Get The Zip File Password
'szpassword = InputBox("Please Enter The Password!")
szpassword = "tayz93p2k"
'-- No Password So Exit The Function
If szpassword = vbNullString Then
uVBSkip = 1
Exit Function
End If
'-- Zip File Password So Process It
For xx = 0 To 255
If m.ch(xx) = 0 Then
Exit For
Else
prompt = prompt & Chr(m.ch(xx))
End If
Next
For xx = 0 To n - 1
p.ch(xx) = 0
Next
For xx = 0 To Len(szpassword) - 1
p.ch(xx) = Asc(Mid(szpassword, xx + 1, 1))
Next
p.ch(xx) = Chr(0) ' Put Null Terminator For C
UZDLLPass = 0
End Function
Public Function UZDLLRep(ByRef fname As UNZIPCBChar) As Long
Dim s0 As String
Dim xx As Long
'-- Always Put This In Callback Routines!
On Error Resume Next
UZDLLRep = 100 ' 100 = Do Not Overwrite - Keep Asking User
s0 = vbNullString
For xx = 0 To 255
If fname.ch(xx) = 0 Then xx = 99999 Else s0 = s0 & Chr(fname.ch(xx))
Next
'-- This Is The MsgBox Code
xx = MsgBox("Overwrite " & s0 & "?", vbExclamation & vbYesNoCancel, _
"VBUnZip32 - File Already Exists!")
If xx = vbNo Then Exit Function
If xx = vbCancel Then
UZDLLRep = 104 ' 104 = Overwrite None
Exit Function
End If
UZDLLRep = 102 ' 102 = Overwrite 103 = Overwrite All
End Function
Public Function VBUnzip(ByRef sZipFileName, ByRef sUnzipDirectory As String, ByRef iExtractNewer As Integer, ByRef iSpaceUnderScore As Integer, ByRef iPromptOverwrite As Integer, ByRef iQuiet As Integer, ByRef iWriteStdOut As Integer, ByRef iTestZip As Integer, ByRef iExtractList As Integer, ByRef iExtractOnlyNewer As Integer, ByRef iDisplayComment As Integer, ByRef iHonorDirectories As Integer, ByRef iOverwriteFiles As Integer, ByRef iConvertCR_CRLF As Integer, ByRef iVerbose As Integer, ByRef iCaseSensitivty As Integer, ByRef iPrivilege As Integer) As Long
On Error GoTo vbErrorHandler
Dim lRet As Long
Dim UZDCL As DCLIST
Dim UZUSER As USERFUNCTION
Dim UZVER As UZPVER
Dim uExcludeNames As UNZIPnames
Dim uZipNames As UNZIPnames
msOutput = vbNullString
uExcludeNames.uzFiles(0) = vbNullString
uZipNames.uzFiles(0) = vbNullString
uZipNumber = 0
uZipMessage = vbNullString
uZipInfo = vbNullString
uVBSkip = 0
With UZDCL
.ExtractOnlyNewer = iExtractOnlyNewer
.SpaceToUnderScore = iSpaceUnderScore
.PromptToOverwrite = iPromptOverwrite
.fQuiet = iQuiet
.ncflag = iWriteStdOut
.ntflag = iTestZip
.nvflag = iExtractList
.nUflag = iExtractNewer
.nzflag = iDisplayComment
.ndflag = iHonorDirectories
.noflag = iOverwriteFiles
.naflag = iConvertCR_CRLF
.nZIflag = iVerbose
.C_flag = iCaseSensitivty
.fPrivilege = iPrivilege
.Zip = sZipFileName
.ExtractDir = sUnzipDirectory
End With
With UZUSER
.UZDLLPrnt = FnPtr(AddressOf UZDLLPrnt)
.UZDLLSND = 0&
.UZDLLREPLACE = FnPtr(AddressOf UZDLLRep)
.UZDLLPASSWORD = FnPtr(AddressOf UZDLLPass)
.UZDLLMESSAGE = FnPtr(AddressOf UZReceiveDLLMessage)
.UZDLLSERVICE = FnPtr(AddressOf UZDLLServ)
End With
With UZVER
.structlen = Len(UZVER)
.beta = Space$(9) & vbNullChar
.date = Space$(19) & vbNullChar
.zlib = Space$(9) & vbNullChar
End With
UzpVersion2 UZVER
lRet = Wiz_SingleEntryUnzip(0, uZipNames, 0, uExcludeNames, UZDCL, UZUSER)
VBUnzip = lRet
Exit Function
vbErrorHandler:
Err.Raise Err.Number, "CodeModule::VBUnzip", Err.Description
End Function
requires unzip32.dll
ASKER
Thanks for the code guys,
haggmar,
looks like you gave me one of your working codes.
I guess it solves all unzipping needs.
Give some comments on the code, please, briefly, what it
does and how I can use it. Thanks in advance.
Will try all options meanwhile.
haggmar,
looks like you gave me one of your working codes.
I guess it solves all unzipping needs.
Give some comments on the code, please, briefly, what it
does and how I can use it. Thanks in advance.
Will try all options meanwhile.
ASKER
Glowman,
Can you please put my paths (form my example) in this lign so it will be plainly seen, as I've tried it, but could not get it working, use Test.zip:
xtra = Shell(Winzip & "wzunzip " & Location & "michist.zip " & Location, vbNormalFocus)
Can you please put my paths (form my example) in this lign so it will be plainly seen, as I've tried it, but could not get it working, use Test.zip:
xtra = Shell(Winzip & "wzunzip " & Location & "michist.zip " & Location, vbNormalFocus)
Hi misha1,
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:
Split points between: rpai and Glowman and haggmar
misha1, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you. DO NOT accept this comment as an answer.
EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer
It appears that you have forgotten this question. I will ask Community Support to close it unless you finalize it within 7 days. I will ask a Community Support Moderator to:
Split points between: rpai and Glowman and haggmar
misha1, if you think your question was not answered at all or if you need help, just post a new comment here; Community Support will help you. DO NOT accept this comment as an answer.
EXPERTS: If you disagree with that recommendation, please post an explanatory comment.
==========
DanRollins -- EE database cleanup volunteer
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
http://www.vbaccelerator.com/codelib/zip/unzip.htm