VBScript nach VBA (Excel2007) unwandeln

[Drohne]

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?

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

 

[ronaldh]

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.

 

[Drohne]

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