Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1004to1008
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

ZIP-Dateien entapcken?

ZIP-Dateien entapcken?
25.08.2008 18:39:02
Selma
Hallo Leute,
ich habe eine Frage. Was muss ich in unten eingefügtem Code verändern, damit die ZIP-Dateien in selben Ordner entpackt werden? Ich möchte keinen festen Pfad. Die Dateien sollen da liegen, wo auch die zu entpackende ZIP-Dateien liegen.

Sub Unzip2()
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
'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 & "\"
'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
oApp.Namespace(FileNameFolder).CopyHere _
oApp.Namespace(Fname).items.Item(CStr(fileNameInZip))
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
End Sub


Vielen Dank im Voraus...
Liebe Grüße
Selma

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ZIP-Dateien entapcken?
25.08.2008 19:41:38
Jürgen
Hallo Selma,
statt
DefPath = Application.DefaultFilePath
nimm
DefPath = fso.GetParentFolderName(Fname)
Gruß, Jürgen
AW: ZIP-Dateien entapcken?
25.08.2008 21:25:00
Selma
Hallo Jürgen,
leider bleibt das Makro hier "DefPath = FSO.GetParentFolderName(Fname)" hängen.
Gibt es eine andere Möglichkeit ?
Viele Grüße,
Selma
AW: ZIP-Dateien entapcken?
25.08.2008 22:04:00
Jürgen
Hallo Selma,
ich hatte übersehen, dass das FSO-Objekt erst hanz am Schluß initialisiert wird. Verschiebe einfach die Zeile
Set FSO = CreateObject("scripting.filesystemobject")
weiter nach oben (z.B. direkt unter die Zeilen mit DIM).
Übrigens: wenn ein Makro hängen bleibt, geschieht das mit einer Fehlermeldung - deren Kenntnis hätte die Fehlersuche erleichtert...
Gruß, Jürgen
Anzeige
AW: ZIP-Dateien entapcken?
25.08.2008 22:35:00
Selma
Hallo Jürgen,
ich habe leider falsches Makro von http://www.rondebruin.nl/windowsxpunzip.htm kopiert. Sorry ;(
Ich benutze das Example 4. So habe ich es versucht:

Sub Unzip4_neu()
'neu mit ein paar Änderungen
Dim FSO As Object
Dim oApp As Object
Dim Fname
Dim FileNameFolder
Dim DefPath As String
Set FSO = CreateObject("scripting.filesystemobject")
Fname = Application.GetOpenFilename(filefilter:="Zip Dateien (*.zip), *.zip, Alle Dateien (* _
.*), *.*", _
Title:="Bitte Datei/-en zum Entpacken auswählen", MultiSelect:=True)
If IsArray(Fname) = False Then
Selection.Delete
Range("A1").Select
End
'do nothing
Else
DefPath = FSO.GetParentFolderName(Fname)
If Right(DefPath, 1)  "\" Then
DefPath = DefPath & "\"
End If
FileNameFolder = DefPath
Set oApp = CreateObject("Shell.Application")
For I = LBound(Fname) To UBound(Fname)
num = oApp.Namespace(FileNameFolder).items.Count
'Copy the files in the newly created folder
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname(I)).items
On Error Resume Next
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Next I
'MsgBox "You find the files here: " & FileNameFolder
Set oApp = Nothing
Set FSO = Nothing
End If
End Sub


Es kommt die Fehlermeldung "Laufzeitfehler 13" Typen unverträglich."
Was muss geändert werden?
Viele Grüße,
Selma

Anzeige
AW: ZIP-Dateien entapcken?
25.08.2008 23:13:00
Nepumuk
Hallo Selma,
FSO.GetParentFolderName(Fname)
geht so natürlich nicht, denn Fname ist ja ein Array. Die GetParentFolderName-Methode erwartet aber einen String als Parameter. Da aber alle Dateien in einem Ordner liegen (der Dialog lässt ja nur einen zu) kannst du das erste Element des Arrays benutzen.
FSO.GetParentFolderName(Fname(LBound(Fname)))
Ach ja, IsArray gibt einen boolschen Wert zurück, den musst du nicht mit etwas vergleichen, sondern den kannst du direkt benutzen. Da du die Negation des Wertes benutz, einfach If Not IsArray(Fname) Then
Gruß
Nepumuk
AW: ZIP-Dateien entapcken?
26.08.2008 08:46:00
Selma
Vielen Dank Nepumuk !
Liebe Grüße,
Selma
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige