20.08.2024, 19:44
Hallo,
der VBA-Befehl Kill löscht ja eine Datei unwiderruflich.
Wer Dateien lediglich in den Papierkorb schicken möchte, um sie später vielleicht doch wieder dort raus zu kramen, kann folgenden Code dafür nutzen.
der VBA-Befehl Kill löscht ja eine Datei unwiderruflich.
Wer Dateien lediglich in den Papierkorb schicken möchte, um sie später vielleicht doch wieder dort raus zu kramen, kann folgenden Code dafür nutzen.
Code:
Private Declare PtrSafe Function SHFileOperationA Lib "Shell32.dll" ( _
lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
hwnd As LongPtr
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As LongPtr
lpszProgressTitle As String
End Type
Private Sub VerschiebeDateiIndenPapierkorb(sDateiname As String)
Dim tStruct As SHFILEOPSTRUCT
Const FOF_ALLOWUNDO As Long = &H40 ' Datei wird in den Papierkorb verschoben
Const FOF_FILESONLY As Long = &H80 ' Löscht nur Dateien, keine Verzeichnisse
Const FOF_NOCONFIRMATION As Long = &H10 ' Löscht ohne Rückfrage
Const FOF_SILENT As Long = &H4 ' Zeigt keinen Fortschrittsbalken an.
tStruct.wFunc = &H3 ' &H3& = FO_DELETE
tStruct.pFrom = sDateiname
tStruct.fFlags = FOF_ALLOWUNDO Or FOF_SILENT Or FOF_NOCONFIRMATION
SHFileOperationA tStruct ' Jetzt löschen
End Sub
' ##### Test ####
Sub Test()
VerschiebeDateiIndenPapierkorb "D:\Freigericht.png"
End Sub
lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
hwnd As LongPtr
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As LongPtr
lpszProgressTitle As String
End Type
Private Sub VerschiebeDateiIndenPapierkorb(sDateiname As String)
Dim tStruct As SHFILEOPSTRUCT
Const FOF_ALLOWUNDO As Long = &H40 ' Datei wird in den Papierkorb verschoben
Const FOF_FILESONLY As Long = &H80 ' Löscht nur Dateien, keine Verzeichnisse
Const FOF_NOCONFIRMATION As Long = &H10 ' Löscht ohne Rückfrage
Const FOF_SILENT As Long = &H4 ' Zeigt keinen Fortschrittsbalken an.
tStruct.wFunc = &H3 ' &H3& = FO_DELETE
tStruct.pFrom = sDateiname
tStruct.fFlags = FOF_ALLOWUNDO Or FOF_SILENT Or FOF_NOCONFIRMATION
SHFileOperationA tStruct ' Jetzt löschen
End Sub
' ##### Test ####
Sub Test()
VerschiebeDateiIndenPapierkorb "D:\Freigericht.png"
End Sub
_________
viele Grüße
Karl-Heinz
viele Grüße
Karl-Heinz