Here is a code example in Visual Basic 6 allowing cyclically extract all the zipped files contained in a folder.
It often happens to have many zipped files, perhaps large, to extract and to avoid wasting a lot of time you can run this script in VB6 to have the contents of your zipped files extracted and uncompressed.
How to extract all compressed files present in a folder in VB6
All you have to do is indicate the path of the zipped files in sDirectory and the path of the extracted files in sDirectoryNew. Of course you can customize the script by inserting an InputBox to give the user the possibility to insert the paths or change the extensions of the files contained in the zip files. To you the choice.
Good code!
Private Sub Form_Load ()
Dim FirstPath As String
Dim contatore As Long
sDirectory as string
sDirectoryNew as string
counter = 1
sDirectory = "E: MOVEMENTS_CC2014"
sDirectoryNew = "E: CC_MOVEMENTS to be loaded"
ReDim Files(0)
stemp = Dir $ (sDirectory)
Do Until stemp = “”
If stemp “.” And stemp “..” And GetAttr(sDirectory & stemp) vbDirectory Then
ReDim Preserve Files(UBound(Files) + 1)
Files(UBound(Files)) = stemp
DefPath = sDirectory
If Right(Trim(stemp), 4) = “.zip” Or Right(Trim(stemp), 4) = “.ZIP” Then
'extract the files
Fname = sDirectory & stemp
‘Application.GetOpenFilename(filefilter:=”Zip Files (*.zip), *.zip”, MultiSelect:=False)
'
If Fname = False Then
‘Do nothing
else
‘Root folder for the new folder.
‘You can also use DefPath = “C:UsersRontest”
‘DefPath = Application.DefaultFilePath
If Right(DefPath, 1) “” Then
DefPath = DefPath & “”
End If
‘Create the folder name
‘ strDate = Format(Now, ” dd-mm-yy h-mm-ss”)
‘FileNameFolder = DefPath & “MyUnzipFolder ” & strDate & “”
FileNameFolder = DefPath
‘Make the normal folder in DefPath
‘MkDir FileNameFolder
‘Extract the files into the newly created folder
Set oApp = CreateObject(“Shell.Application”)
‘Change this “*.txt” to extract the files you want
For Each fileNameInZip In oApp.Namespace(Fname).items
If LCase(fileNameInZip) Like LCase(“*.txt”) Then
FirstPath = sDirectoryNew & stemp & “.txt”
If ExistFile(FirstPath) = False Then
oApp.Namespace(FileNameFolder).CopyHere _
oApp.Namespace(Fname).items.Item(CStr(fileNameInZip))
'insert pause
‘Application.Wait Now + TimeValue(“00:00:05”)
‘If InStr(fileNameInZip, “giornaliero”) > 0 Then
check if it already exists
‘if Fname
Name sDirectory & fileNameInZip As sDirectoryNew & stemp & “.txt”
counter = counter + 1
End If
‘End If
End If
Next
‘MsgBox “You find the files here: ” & FileNameFolder
On Error Resume Next
Set FSO = CreateObject(“scripting.filesystemobject”)
FSO.deletefolder Environ(“Temp”) & “Temporary Directory*”, True
End If
else
‘Exit Do
End If
End If
stemp = Dir ()
loop
Elencafile = Files
FSO.Close
oApp.Close
Set FSO = Nothing
Set oApp = Nothing
End Sub
Function ExistFile(NomeFile As String) As Boolean
On Error Resume Next
ExistFile = (GetAttr(NomeFile) And vbDirectory) = 0
End Function
