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? Leider fehlen mir die geltlichen Mitteln also suche ich jemanden der dies frewillig macht. Dankeschön.

Code :

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78

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

Würde das eher in das Forum "Programmieren" packen, ist wohl stärker frequentiert und ist ja schließlich auch ein spezifisches Problem.

Dort haben Sie mich auf diesen Forumsteil verwiesen. Also steht es jetzt doppelt drin. Eine Lösung konnte ich aber bis heute nicht finden.

Da hab ich vor geraumer Zeit einen guten Text dazu verfasst. Darum zitiere ich ihn immer wieder gerne

Ehrenamtlich arbeite ich nur für gemeinnützige und wohltätige Dinge oder für Gruppen denen ich angehöre oder deren Ziel mich fasziniert/Interessiert.

Da du aber nix von dir/euch geschrieben hast, gehe ich mal nicht davon aus, dass ihr dazugehört.