Visual Basic 6: come estrarre tutti i file compressi presenti in una cartella
Ecco un esempio di codice in Visual Basic 6 che consente di estrarre in maniera ciclica tutti i file zippati contenuti in una cartella.
Capita spesso di avere tantissimi file zippati, magari di grandi dimensioni, da estrarre e per evitare di perdere molto tempo è possibile lanciare questo script in VB6 per avere il contenuto dei vostri file zippati estratti e non compressi.
Come estrarre tutti i file compressi presenti in una cartella in VB6
Tutto quello che dovete fare è indicare la path dei file zippati in sDirectory e la path dei file estratti in sDirectoryNew. Naturalmente potete personalizzare lo script inserendo una InputBox per dare la possibilità all’utente di inserire le path o cambiare le estensioni dei files contenuti nei file zip. A voi la scelta.
Buon codice!
Private Sub Form_Load()
Dim FirstPath As String
Dim contatore As Long
sDirectory as string
sDirectoryNew as string
contatore = 1
sDirectory = “E:\MOVIMENTI_CC\2014\”
sDirectoryNew = “E:\MOVIMENTI_CC\da caricare\”
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
‘fai estrazione dei file
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:\Users\Ron\test\”
‘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))
‘inserisci pausa
‘Application.Wait Now + TimeValue(“00:00:05”)
‘If InStr(fileNameInZip, “giornaliero”) > 0 Then
‘controllo se già esiste
‘if Fname
Name sDirectory & fileNameInZip As sDirectoryNew & stemp & “.txt”
contatore = contatore + 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