x64-Papierkorb per VBA - Code von Nepumuk
Nepumuk
Ich habe Deinen Code für den Papierkorb gefunden:
Option Explicit
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" ( _
ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
Private Const FO_DELETE = &H3&
Private Const FOF_ALLOWUNDO = &H40&
Private Sub Move_to_Recycling_Bin(strFilename As String)
Dim udtFileStructure As SHFILEOPSTRUCT
With udtFileStructure
.wFunc = FO_DELETE
.pFrom = strFilename
.fFlags = FOF_ALLOWUNDO
End With
SHFileOperation udtFileStructure
End Sub
Public Sub Beispiel()
Call Move_to_Recycling_Bin("C:\test") 'Ordner (samt Inhalt) löschen
Call Move_to_Recycling_Bin("C:\MOF.xls") 'Datei löschen
End Sub
Tolle Sache und läuft sehr gut. Zur Zeit stricke ich meinen Code nach 64bit um. Allerdings stürzte Excel bei diesem Code immer ab. Folgende Änderungen habe ich vorgenommen und es läuft jetzt:Option Explicit
#If Win64 Then
Private Declare PtrSafe Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" ( _
ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
hwnd As LongPtr
wFunc As LongPtr
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As LongPtr
hNameMappings As LongPtr
lpszProgressTitle As String
End Type
#Else
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" ( _
ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String
End Type
#End If
Private Const FOF_SILENT = &H4
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_ALLOWUNDO = &H40&
Private Const FO_DELETE = &H3&
Vielen Dank nochmal
Michael H