Hallo Gemeinde,
Ich hoffe ich bin hier richtig und finde jemanden, der mir diesen angehängten vbs Script nach VBA für Excel2007 umwandelt.
Der Code stammt von meiner Anfrage hier : http://www.administrator.de/index.php?content=151233
Vielleicht finde ich ja hier den Fuchs der das ganze von VBS auf VBA umschtreibt oder noch eine Idee dazu hat?
Liebe Grüße
Drohne
Ich hoffe ich bin hier richtig und finde jemanden, der mir diesen angehängten vbs Script nach VBA für Excel2007 umwandelt.
Der Code stammt von meiner Anfrage hier : http://www.administrator.de/index.php?content=151233
Vielleicht finde ich ja hier den Fuchs der das ganze von VBS auf VBA umschtreibt oder noch eine Idee dazu hat?
Code:
Option Explicit
Dim fso, csvFilePath,csvFile,fname
fname = "D:\Temp" 'Der Pfad zum Ordner wo die Rechte ausgelesen werden sollen
csvFilePath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\")) & "myCsvlist.csv" 'csvFile wird In
'selben Ordner wie das Script gelegt bzw erzeugt
Set fso = CreateObject("Scripting.FileSystemObject")
Set csvFile = fso.OpenTextFile(csvFilePath,8,True)
csvFile.WriteLine(VbCrLf & "Ausgelesene Daten vom " & Now & VbCrLf)
Call main
MsgBox "fertig"
Sub main()
Dim folder
Set folder = fso.GetFolder(fname)
recFolder(folder)
csvFile.Close
End Sub
Sub recFolder(fname)
Dim subfolder
csvFile.Write(readacl(fname))
For Each subfolder In fname.SubFolders
recFolder(subfolder)
Next
End Sub
Function readacl(Folder)
readacl = True
Dim wmi
Dim Result
Dim AFlags, FormatType,fss,sts,dce,sd
Result = Folder & ";"
Set wmi = GetObject("winmgmts:{impersonationLevel=Impersonate,(TakeOwnership)}!\\.\root\cimv2")
Set fss = wmi.Get("Win32_LogicalFileSecuritySetting='" & fname & "'")
sts = fss.GetSecurityDescriptor(sd)
For Each dce In sd.dacl
Result = Result & dce.Trustee.Name & ";"
Result = Result & dce.Trustee.SIDString & ";"
Select Case hex(dce.AccessMask)
'Eine Dokumentation über die AccessMask findest du bei MSDN, ich habe die 3 geläufigsten aufgelistet:
Case "1F01FF"
FormatType= "Full"
Case "1301BF"
FormatType = "Write"
Case "1200A9"
FormatType = "Read"
Case Else
FormatType = "Unspecified"
End Select
Result = Result & FormatType & ";"
'Eine Dokumentation über die AceFlags findest du bei MSDN, ich habe dir ein paar Bsp gelistet:
Select Case Hex(dce.AceFlags)
Case "0"
AFlags = "NUR DIESER ORDNER ---- nicht geerbt"
Case "3"
AFlags = "diesen Ordner, Unterordner und Dateien ---- nicht geerbt"
Case "13"
AFlags = "NUR DIESER ORDNER ---- geerbt"
Case "1B"
AFlags = "Nur Unterordner und Dateien --- geerbt"
End Select
Result = Result & AFlags & ";" & VbCrLf & ";"
Next
Result = Left(Result,Len(Result)-1)
readacl = Result
End Function
Liebe Grüße
Drohne