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?

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

Ich denke, wenn Du das umgewandelt haben willst, solltest Du dies in dem Forum "Jobbörse entgeltlich/unentgeltlich" schreiben.

Dieses Forum ist doch eher dafür da, Dir Hilfestellung zu geben, wenn Du spezifische Probleme hast.

Ich habe es da reingesetzt. Leider bisher ohne Resonanz. Ich hoffe aber dennoch das sich was ergibt.