estrarre file da file zip

Hai un problema con Excel?

Nuova discussione

estrarre file da file zip
di rita (utente non iscritto) data: 01/03/2013 08:28:36
ciao a tutti tempo fa ho trovato
l'istruzione qi sotto riportata che funziona perfettamente ed estrae da un file zip il suo contenuto copiando il file nel disco c. In questo caso il file estratto e di tipo txt ma cambiando l'estensione si puo' estrarre qualsiasi tipo di file
Il problema e' che la sub funziona solo se il file zippato contiene un file ma non riesco a farla funzionare se il file zippato contiene piu' file
qualcuno sa dove poter intervenire?

SUB ESTRAI()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Dim fileNameInZip As Variant
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
Else
DefPath = Application.DefaultFilePath
If Right(DefPath, 1) <> "" Then
DefPath = DefPath & ""
End If
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & ""
MkDir FileNameFolder
Set oApp = CreateObject("Shell.Application")
For Each fileNameInZip In oApp.Namespace(Fname).items
If LCase(fileNameInZip) Like LCase("*.txt") Then
oApp.Namespace(FileNameFolder).CopyHere _
oApp.Namespace(Fname).items.Item(CStr(fileNameInZip))
End If
xxx = fileNameInZip
Next
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.DeleteFolder Environ("Temp") & "Temporary Directory*", True
End If
Set f2 = FSO.GetFile(DefPath & "MyUnzipFolder " & strDate & "" & xxx)
f2.Move ("c:" & xxx)
FSO.DeleteFolder (DefPath & "MyUnzipFolder " & strDate)
Workbooks.OpenText Filename:=DefPath & "" & xxx, Origin:=xlMSDOS, StartRow _
:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
16, 1), Array(17, 1)), TrailingMinusNumbers:=True
END SUB

di Vecchio Frac data: 01/03/2013 15:18:54
Mamma che garbuglio di codice :)
Ti suggerisco un codice più snello, è pure commentato.
Questo estrae da un file zippato i soli file .txt, ma è facilmente adattabile, anche per richiedere nome del file zippato e percorso.

Sub Unzip()
Dim fso As Object, oShell As Object, zip_file As String, destination As String, f As Variant

    zip_file = "c:percorso completo
ome del file.zip"    '<-- nome completo di percorso del file zip
    destination = "c:dove salvare i file estratti"       '<-- deve terminare con ""
    If Right(destination, 1) <> "" Then destination = destination & ""

    'crea l'oggetto Shell
    Set oShell = CreateObject("Shell.Application")

    'estrae solo i file *.txt dall'archivio zippato
    With oShell
        '.Namespace() restituisce un oggetto Folder, che contiene dei file
        For Each f In .Namespace((zip_file)).items   '<-- la doppia parentesi è necessaria! altrimenti zip_file e destination vanno dichiarati Variant
            If LCase(f) Like LCase("*.txt") Then
                .Namespace((destination)).CopyHere .Namespace((zip_file)).items.Item(CStr(f))
            End If
        Next
    End With

    On Error Resume Next
    
    'elimina dal disco la cartella temporanea c reata da WInZip durante l'estrazione
    Set fso = CreateObject("scripting.filesystemobject")
    fso.deletefolder Environ("Temp") & "Temporary Directory*", True

End Sub

di rita (utente non iscritto) data: 06/03/2013 08:13:01
ciao vecchio frac e grazie della risposta
ho impostato come hai detto tu solo che mi va in debug sull'istruzione qui sotto e mi dice
....variable oggetto o variabile del blocco with non impostata

For Each f In .Namespace((zip_file)).items
di rita (utente non iscritto) data: 06/03/2013 15:20:08
ciao vecchio frac, probabilmente nel copiare la tua istruzione avevo dimenticato qualcosa perche' ho provato a ricopiarla ed ora funziona perfettamente.
volevo chiederti se avresti una soluzione al contrario ossia da una cartella contenente dei file txt o altro poterli accorpare in un file zip sempre da vba
grazie
di Vecchio Frac data: 06/03/2013 15:22:18
Sempre con Shell e il percorso di WInzip (o Winrar)... sicuramente il metodo più semplice ^_^
Devo provarci.
di rita (utente non iscritto) data: 06/03/2013 16:02:45
grazie
di rita (utente non iscritto) data: 11/03/2013 08:46:58
...... hai avuto modo di provarlo?
di RITA (utente non iscritto) data: 11/03/2013 10:05:01
guardando un po qui e un po li ho trovato un sito dove ho adattato la sub e sembra funzionare
in ogni caso grazie dell'interessamento

di Vecchio Frac data: 11/03/2013 10:59:26
Sì, non avevo più provato ma Ron De Bruin ha sviluppato una soluzione efficace.
E' molto curiosa e va verificata (sembra che con Access 2003 dia problemi).
Io invece intendevo costruire la stringa da dare in pasto a Winzip mediante Shell; anche qui Ron De Bruin è stato illuminante
:
'Zip all the files in the folder and subfolders, -r is Include subfolders
'If you add -p, WinZip will store folder information for all files added,
'not just for files from subfolders; the folder information will begin with
'the folder specified on the command line.
ShellStr = PathZipProgram & "Winzip32.exe -min -a -r" _
& " " & Chr(34) & NameZipFile & Chr(34) _
& " " & Chr(34) & FolderName & "*.*" & Chr(34)

Sub NewZip(sPath)
'Create empty Zip File
'Changed by keepITcool Dec-12-2005
    If Len(Dir(sPath)) > 0 Then Kill sPath
    Open sPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
End Sub

Vuoi Approfondire?