wir haben auf einem Sharepoint eine ZIP-Datei.
Darin enthalten sind viele einzelne Dateien (pdf und xls)
Gibt es eine Möglichkeit, diese Dateinamen
in eine Excel-Datei "einzulesen" ?
Freu mich auf einen Tipp
Gruß
Werner
https://www.rondebruin.nl/win/s7/win002.htm
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
Sub T_1()
Pf = "c:\users\...\desktop\"
f = "iName.xlsm.zip"
With CreateObject("shell.application").Namespace(Pf & f)
For i = 0 To .Items.Count - 1
Debug.Print .Items.Item(i)
Next i
End With
End Sub