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.
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
Non perdere nessuna notizia, aggiungici agli amici! | |
Segui Informarea |
Se volete seguire i post di www.informarea.it potete iscrivervi al suo feed RSS.