ich lasse eine .zip-Datei durch Excel entpacken, für die durch VBA ein entsprechender Ordner angelegt wird. Diesen Ordner würde ich gerne in den Zwischenspeicher laden (also einfach kopieren ohne bisheriges Ziel) um ihn dann manuell auf einen USB-Stick einzufügen.
Ich würde gerne direkt verschieben, hierfür hätte ich auch den entsprechenden Code. Leider gibt es Zugriffsbeschränkungen beim Laufwerk USB-Stick, so dass dieses nicht funktioniert.
Gibt es die Möglichkeit für das beschriebene?
Code zum entpacken:
Sub UnzipPF()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
Else
DefPath = "G:\...\...\...\Beratungen\Transfer_PF\"
If Right(DefPath, 1) "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "Beratungsunterlagen_" & Range("K7") & "_" & Range("T7")
'Make the normal folder in DefPath
MkDir FileNameFolder
'Extract the files into the newly created folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).Items
'If you want to extract only one file you can use this:
'oApp.Namespace(FileNameFolder).CopyHere _
'oApp.Namespace(Fname).items.Item("test.txt")
MsgBox "Die Dateien sind hier zu finden: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
Vielen Dank für Eure Hilfe!
Gruß,
Patrick