Mittlerweile klappt das Entpacken per application.getopenfilename aber es hat sich herausgestellt, dass das unpraktikabel ist, da täglich mehrere Zip-Dateien einlaufen, wovon immer die aktuellste entpackt werden soll. In einer anderen Tabelle habe ich bereits diese Abfrage der jüngsten Datei erfolgreich implementiert doch hier vermag ich nicht den Dateinamen der aktuellsten Datei an die unzip-Routine zu übergeben, die ich nebenbei gesagt, gar nicht verstehe.
An welcher Stelle wird denn entpackt? Also welcher Befehl bewirkt das?
Also mein Code identifiziert die aktuellste Datei, was ich durch die MSGbox-Abfrage überprüfen kann.Das funktioniert. Nur die Übergabe zu oApp oder was auch immer das Entpacken einleitet, funktioniert leider nicht. Ich hoffe ich habe mein Ziel, die jeweils die jüngste Datei in denselben Ordner zu entpacken, gut beschrieben und ihr könnt mir helfen. Aber da mache ich mir weniger Sorgen. Dies Forum geht ab!
Danke Daniel
PS: hier mal mein zusammenkopierter Code. Nicht lachen. Bin absouter Anfänger:
Sub unzip2()
' jüngste Datei feststellen und entpacken
Dim strVerzeichnis As String
Dim StrDatei As String
Dim I As Integer
Dim StrTyp As String
Dim Dateiname As String
Dim Dateiname_neu As String
Dim Zeit As Date
strVerzeichnis = "c:\pfad\"
StrTyp = "*.zip"
Dateiname = Dir(strVerzeichnis & StrTyp)
Dateiname_neu = Dateiname
Zeit = FileDateTime(strVerzeichnis & Dateiname)
Do While Dateiname <> ""
If Zeit < FileDateTime(strVerzeichnis & Dateiname) Then
Zeit = FileDateTime(strVerzeichnis & Dateiname)
Dateiname_neu = Dateiname
End If
Dateiname = Dir
Loop
MsgBox " Die jüngste Datei ist " & Dateiname_neu
'Jetzt geht das Entpacken los
Dim FSO As Object
Dim oApp As Object
Dim fname
Dim FileNameFolder
Dim DefPath As String
DefPath = "c:\Pfad\" '<<< Change path
FileNameFolder = DefPath
fname = "Dateiname_neu"
Set oApp = CreateObject("Shell.Application")
'Copy the files in the newly created folder
oApp.NameSpace(FileNameFolder).CopyHere oApp.NameSpace(fname).Items
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
Set oApp = Nothing
Set FSO = Nothing
End Sub