Erledigt
28.10.2011 11:07:34
Andi
erledigt . Danke an Alias Nepumuk
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************
Option Explicit
Private Const FILE_ALL_ACCESS = &H1F01FF
Private Const FILE_APPEND_DATA = &H4
Private Const FILE_DELETE = &H10000
Private Const FILE_DELETE_CHILD = &H40
Private Const FILE_EXECUTE = &H20
Private Const FILE_READ_ATTRIBUTES = &H80
Private Const FILE_READ_CONTROL = &H20000
Private Const FILE_READ_DATA = &H1
Private Const FILE_READ_EA = &H8
Private Const FILE_SYNCHRONIZE = &H100000
Private Const FILE_WRITE_ATTRIBUTES = &H100
Private Const FILE_WRITE_DAC = &H40000
Private Const FILE_WRITE_DATA = &H2
Private Const FILE_WRITE_EA = &H10
Private Const FILE_WRITE_OWNER = &H80000
Public Sub test()
Dim lngReturn As Long
lngReturn = Check_Folderaccess(CStr(BrowseForFolder)) '("D:\Eigene Dateien\aviproxy")
If Not lngReturn And FILE_WRITE_DATA Then MsgBox "Nicht schreiben"
If Not lngReturn And FILE_READ_DATA Then MsgBox "Nicht lesen"
If lngReturn And (FILE_WRITE_DATA Or FILE_READ_DATA) Then MsgBox "Vollzugriff"
End Sub
Private Function Check_Folderaccess(strFolder As String) As Long
Dim objWMI As Object, objItem As Object
Dir$ ""
strFolder = (Replace(strFolder, "\", "\\"))
Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
ExecQuery("Select * from Win32_Directory Where Name = '" & strFolder & "'")
For Each objItem In objWMI
Check_Folderaccess = objItem.AccessMask
Next
End Function