AW: Dateiname in ZIP-file auslesen
03.08.2018 16:12:08
Karl-heinz
Hallo Werner,
hier ein stark 'zusammengedampfter' Code zum Extrahieren der Dateinamen. Habe ich mal in String zurückgeben lassen. Man kann das ja ausgeben, wie immer man will.
Meine Vollversion ermittelt natürlich auch alle anderen Parameter wie Datum, Suffix, Größen usw., aber Du wolltest ja nur die Dateinamen.
Probiere es einfach mal aus. Bei mir läuft's.
Viele Grüße
Karl-Heinz
Sub Starte()
Dim Data() As String, i As Integer
Data = Split(Zip_Dateinamen(ThisWorkbook.Path & "\" & "Interactiver Vergleich_Office 2003 to _
2007.zip"), vbCrLf)
Cells.Clear
For i = 0 To UBound(Data)
Cells(i + 1, "A").Value = Data(i)
Next i
End Sub
Function Zip_Dateinamen(Datei As String) As String
'Funktion untersucht eine Zipdatei und ermittelt die enthaltenen Dateien
Dim Data As String, Dateilaenge As Integer, Zeiger As Long, Packed As Long
If Dir$(Datei) "" Then
Close #1: Open Datei For Binary As #1
'Feststellen, ob der Inhalt einer gültigen Zipdatei entspricht; nicht nur die Extension muss _
stimmen
If Input(4, #1) "PK" & Chr$(3) & Chr$(4) Then
MsgBox "Die Datei '" & Datei & "' ist keine Zip-Datei!", vbOKOnly, "Zipinhalt-Ermittlung" _
Close #1: Exit Function
End If
Seek #1, 1
'Einlesen der einzelnen Dateiabschnitte bis zum Inhaltsverzeichnis
Zeiger = 1
Do While Not EOF(1)
Seek #1, Zeiger + 18
Packed = HoleWert(Input(4, #1)) 'Länge des komprimierten Datenbereichs
Seek #1, Zeiger + 26
'Den Zeiger um 30 plus Dateitextlänge plus Offset weitersetzen (Offset für Dateilänge=0 _
gebraucht)
Zeiger = Zeiger + 30 + HoleWert(Input(2, #1)) + HoleWert(Input(2, #1))
Seek #1, Zeiger
If Input(2, #1) "PK" Then Zeiger = Zeiger + Packed 'Bei eingebundener ZipDatei ist _
kein Datenbody vorhanden
Seek #1, Zeiger
If Input(4, #1) = "PK" & Chr$(1) & Chr$(2) Then Exit Do
Loop
'Einlesen des Inhaltsverzeichnis
Seek #1, Zeiger
Do While Not EOF(1)
Select Case Input(4, #1) 'vierstellige PK/UT-Kennung lesen
Case "PK" & Chr$(1) & Chr$(2)
'FirstBlock 8,Uhrzeit 2,Datum 2,Binärblock 4,PackedSize 4,OriginalSize 4 =24 Byte lesen
Data = Input(24, #1)
Dateilaenge = Val(HoleWert(Input(2, #1))) 'Dateilänge
Data = Input(16, #1) 'weiterer unbekannter Binärblock
'Dateinamen und optionalen Pfad ermitteln
Zip_Dateinamen = Zip_Dateinamen & Input(Dateilaenge, #1) & vbCrLf
Case "PK" & Chr$(5) & Chr$(6)
Data = Input(16, #1) 'Mindestbyteanzahl lesen
Do
Data = Input(1, #1)
If EOF(1) Or Data = "P" Then Exit Do
Loop
If EOF(1) Then Exit Do
Seek #1, Seek(1) - 1 'Zeiger wieder vor das "P" setzen
Case "UT" & Chr$(5) & Chr$(0)
Data = Input(9, #1)
Case Else
Do
Data = Input(1, #1)
If EOF(1) Or Data = "P" Then Exit Do
Loop
If EOF(1) Then Exit Do
Seek #1, Seek(1) - 1 'Zeiger wieder vor das "P" setzen
End Select
Loop
Close #1
Else
MsgBox "Die Datei '" & Datei & "' wurde nicht gefunden!", vbOKOnly, "Zipinhalt-Ermittlung"
End If
End Function
Function HoleWert(S As String) As String
'Funktion wandelt einen String in eine Zahl um
Dim i As Integer, D
For i = 1 To Len(S)
D = D + Asc(Mid(S, i, 1)) * 256 ^ (i - 1)
Next
HoleWert = D
End Function