Estrarre da file zip

Hai un problema con Excel?

Nuova discussione

Estrarre da file zip
di Rita (utente non iscritto) data: 03/02/2015 17:13:43
Ciao a tutti , premesso che questa istruzione funzionava benissimo sino a quando avevo xp, ora con win7 non va ossia
una volta lanciata mi si apre una maschera dove seleziono la cartella che contiene i file zip
successivamente individua i file zip e mi inserisce progressivamente nella colonna a da a2 in poi il percorso con il nome del file zip
poi crea una directory di appoggio, estrae nello stesso percorso il file che sempre e' un file di testo ed alla fine cancella il file zip.
perché cavolo non mi funziona con Windows 7?

analizzandola passo passo sembra che non mi consideri questa istruzione
f2.Move (Range("Z1") & "" & xxx)

qualcuno ha un idea

Private 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
Dim myPath, MyFileFound
Dim F As Object
Dim Fi As Object
Dim v, num As Long
Dim MyFile
UserForm1.Hide
Rows("2:65000").Select
    Selection.Delete Shift:=xlUp
    Range("A2").Select
         FILETOOPEN = Application.GetOpenFilename("ZIP Files (*.ZIP), *.ZIP", , "Seleziona la cartella", "Apri", "False")
  file_selezionato = ActiveWorkbook.Name
     If FILETOOPEN = False Then
         Application.CutCopyMode = False
  End
  End If
 Application.ScreenUpdating = False
  Range("Z1").Value = CurDir
'INSERISCO IL NOME E IL PERCORSO NEL FILE
Application.DisplayAlerts = False
MyFile = ActiveWorkbook.FullName
num = 0
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Application.DisplayAlerts = False
myPath = CurDir
Set F = fso.GetFolder(myPath)
For Each Fi In F.Files
If LCase(fso.GetExtensionName(Fi.Path)) = "zip" Then
Range("a" & num + 2) = Fi
num = num + 1
End If
Next
If Range("A2") = "" Then
Exit Sub
Else
conta = Application.WorksheetFunction.CountA(Range("A2:A65000"))
End If
For i = 2 To conta + 1
Fname = Range("A" & i)
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
Set f2 = fso.GetFile(DefPath & "MyUnzipFolder " & strDate & "" & xxx)
f2.Move (Range("Z1") & "" & xxx)
fso.DeleteFolder (DefPath & "MyUnzipFolder " & strDate)
Kill Range("A" & i)
Next i
End Sub

di lepat (utente non iscritto) data: 03/02/2015 18:02:58
elimina o commenta la riga On Error Resume Next e ti accorgerai qual'è il problema
questa sub è molto contorta e a mio parere fa cose veramente inutili

di lepat (utente non iscritto) data: 03/02/2015 18:23:51
io la ridurrei a

Private Sub ESTRAIdaZip()
Dim oApp As Object
FILETOOPEN = Application.GetOpenFilename("ZIP Files (*.ZIP), *.ZIP", , "Seleziona la cartella", "Apri", "False")
If FILETOOPEN = False Then Exit Sub
myPath = CurDir
FileNameFolder = Left(FILETOOPEN, Len(FILETOOPEN) - 4)
MkDir FileNameFolder
Set oApp = CreateObject("Shell.Application")
For Each fileNameInZip In oApp.Namespace(FILETOOPEN).items
  oApp.Namespace(FileNameFolder).CopyHere _
  oApp.Namespace(FILETOOPEN).items.Item(CStr(fileNameInZip))
Next
Set oApp = Nothing
End Sub

di Rita (utente non iscritto) data: 03/02/2015 18:37:39
Grazie Lepat, domani la provo e ti farò saper
di Rita (utente non iscritto) data: 04/02/2015 08:31:02
Ciao Lepat,
partendo dal presupposto che nella mia ho provato a togliere on error resume next ma non mi restituisce nessun tipo di errore e in xp funziona una bomba, ho provato la tua ma nisba ossia se per ipotesi ho una cartella zippata es. pippo e all'interno ho un file txt, con l'istruzione apro e seleziono la cartella ma mi crea una cartella non zippata con lo stesso nome ma il file al suo interno sparisce mentre prima quando evidenziavo la cartella zippata mi estraeva il file nello stesso percorso.
di lepat (utente non iscritto) data: 04/02/2015 12:14:38
la mia versione mi funziona perfettamente, nella tua il problema sta nella riga
fso.DeleteFolder Environ("Temp") & "Temporary Directory*", True
quella cartella non esiste in win 7
di Rita (utente non iscritto) data: 04/02/2015 12:29:56
Ciao Ma che sistema operativo utilizzi?
di lepat (utente non iscritto) data: 04/02/2015 12:37:29
uso win 8 e excel 2010, ma la struttura delle cartelle di win 8 è uguale a quella del 7
di Rita (utente non iscritto) data: 04/02/2015 12:53:28
Ciao
il problema e' che ho provato ad utilizzare la tua istruzione ma non mi estrae il contenuto
e' come se mi estragga la cartella zippata come una cartella normale con lo stesso nome e il contenuto (file txt) sparisce
Come posso fare cavolo, mi serve in ufficio
Da quando sono a win 7 non va un cavolo di quello che prima andava una meraviglia

Vuoi Approfondire?