AW: Datei löschen mit KILL
02.04.2018 22:05:32
Peter(silie)
Hallo,
müsste an den Rechten an der Datei o.ä liegen.
Erstelle ein Neues Modul.
Nenne diese Modul am besten "File"
Kopiere in das Modul "File" untenstehnden Code.
Option Explicit
Private Const OFS_MAXPATHNAME As Long = 128
Private Const OF_EXIST As Long = &H4000
Private Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
#If VBA7 Then
Private Declare PtrSafe Function GetOpenFileName _
Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
ByRef pOpenfilename As OPENFILENAME) _
As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type
#Else
Public Declare Function GetOpenFileName _
Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
ByRef pOpenfilename As OPENFILENAME) _
As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
#End If
#If Win64 Then
Private Declare PtrSafe Function CloseHandle _
Lib "kernel32.dll" ( _
ByVal hObject As Long) _
As Long
Private Declare PtrSafe Function OpenFile _
Lib "kernel32.dll" ( _
ByVal lpFileName As String, _
ByRef lpReOpenBuffer As OFSTRUCT, _
ByVal wStyle As Long) _
As Long
Private Declare PtrSafe Function GetFileSecurity _
Lib "advapi32.dll" Alias "GetFileSecurityA" ( _
ByVal lpFileName As String, _
ByVal RequestedInformation As Long, _
ByRef pSecurityDescriptor As Byte, _
ByVal nLenght As Long, _
ByRef lpnLenghtNeeded As Long) _
As Long
#Else
Private Declare Function CloseHandle _
Lib "kernel32.dll" ( _
ByVal hObject As Long) _
As Long
Private Declare Function OpenFile _
Lib "kernel32.dll" ( _
ByVal lpFileName As String, _
ByRef lpReOpenBuff As OFSTRUCT, _
ByVal wStyle As Long) _
As Long
Private Declare Function GetFileSecurity _
Lib "advapi32.dll" Alias "GetFileSecurityA" ( _
ByVal lpFileName As String, _
ByVal RequestedInformation As Long, _
ByRef pSecurityDescriptor As Byte, _
ByVal nLenght As Long, _
ByRef lpnLenghtNeeded As Long) _
As Long
#End If
Private Declare Function PathIsNetworkPath _
Lib "shlwapi" Alias "PathIsNetworkPathA" ( _
ByVal pszPath As String) _
As Long
Private Declare Function PathIsUNC _
Lib "shlwapi.dll" Alias "PathIsUNCA" ( _
ByVal pszPath As String) _
As Long
' Functions
Public Function PermissionGranted(ByVal pName As String) As Boolean
Dim retVal As Long
Dim lSizeNeeded As Long
Dim bSecDesc() As Byte
Const DACL_SECURITY_INFORMATION As Long = &H4
Const OWNER_SECURITY_INFORMATION As Long = &H1
retVal = GetFileSecurity(pName, _
OWNER_SECURITY_INFORMATION, _
0, _
0&, _
lSizeNeeded)
ReDim bSecDesc(0 To lSizeNeeded) As Byte
retVal = GetFileSecurity(pName, _
OWNER_SECURITY_INFORMATION, _
bSecDesc(0), _
lSizeNeeded, _
lSizeNeeded)
PermissionGranted = CBool(retVal)
End Function
Public Function NetworkFileExists(ByVal pName As String) As Boolean
Dim retVal As Variant
Dim strucFname As OFSTRUCT
If CBool(PathIsUNC(pName)) Then
retVal = OpenFile(pName, strucFname, OF_EXIST)
If retVal -1 Then
NetworkFileExists = True
End If
CloseHandle retVal
End If
End Function
Public Function Exists(ByVal pName As String) As Boolean
If Not CBool(PathIsUNC(pName)) Then
Exists = Dir(pName, vbDirectory) vbNullString
Else
Exists = NetworkFileExists(pName)
End If
End Function
Ändere deinen Code folgend ab:
Private Sub Einlesen_Button_Click()
Dim Fileorigin1, Fileorigin2, SourceFile, DestinationFile As String
Dim Filename, Filepath As String
Fileorigin1 = "C:\Users\ak\Downloads"
Fileorigin2 = "C:\Users\ak\Documents\Allgemein"
Filename = "Test" & ".xls"
SourceFile = Fileorigin1 & "\" & Filename
DestinationFile = Fileorigin2 & "\" & "Ordner1" & "\" & Filename
FileCopy SourceFile, DestinationFile
On Error Resume Next
If File.Exists(SourceFile) Then
If File.PermissionGranted(SourceFile) Then
Kill SourceFile
End If
End If
On Error GoTo 0
End Sub
Durchlaufe alles mit dem Dubugger und guck was die Funktionen etc für Werte zurückgeben.
Kommentiere beim Testen die On Error Statements aus.
PermissionGranted prüft ob du rechte an der Datei oder Ordner hast.
Exists Prüft ob es Datei oder Ordner überhaupt gibt.