Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit
GELÖST

Zugriffsrechte von Ordnern mit VB-Script auslesen

Frage Entwicklung VB for Applications

Mitglied: DieDrohne

DieDrohne (Level 1) - Jetzt verbinden

17.09.2010 um 09:47 Uhr, 14329 Aufrufe, 27 Kommentare, 1 Danke

Script für VB oder CMD zum auslesen von Rechten

Hallo Gemeinde,

Der Beitrag http://www.administrator.de/index.php?content=134881&thread=false hat mir schon weitergeholfen. Allerdings möchte der User dort nur die Besitzer von Ordnern angezeigt bekommen.

Mein Problem ist, das ich einer von mehreren Ablageverwalter bin und für einen Teilbereich einer sehr großen Ablage Verantwortung trage. Jeder Verwalter hat seinen eigenen Bereich wo er User entsprechende Rechte auf die Ordner vergeben kann.

Ich möchte nun eine Dokumentation mit Excel2007(oder Access2007) und einem VBA Script oder einer Batchdatei(cmd) erstellen, mit der ich regelmäßig alle Ordner abfrage und mir dann in einer Liste die User mit ihren entsprechenden Rechten dargestellt werden.

Bisher mach ich das immer händisch, aber wenn ich mal ausfallen sollte, muss ja dokumentiert sein, wer was darf.

Ich benötige eine Übersicht in der Art:

Pfad Dateiname Erstellt User Rechte

Kann mir jemand da weiterhelfen? Denn ich habe jetzt mehrere dutzende Excel-, VB-, Script-Seiten durchsucht, aber nirgends etwas zufriedenstellendes gefunden.

Gruß
DieDrohne
27 Antworten
Mitglied: MonoTone
17.09.2010 um 15:19 Uhr
HI.

Ein kleiner Ansatz:

01.
Option Explicit  
02.
Dim fso, csvFilePath,csvFile,fname 
03.
fname = "D:\Temp" 'Der Pfad zum Ordner wo die Rechte ausgelesen werden sollen 
04.
csvFilePath = Left(WScript.ScriptFullName,InStrRev(WScript.ScriptFullName,"\")) & "myCsvlist.csv" 'csvFile wird In 
05.
'selben Ordner wie das Script gelegt bzw erzeugt 
06.
 
07.
Set fso = CreateObject("Scripting.FileSystemObject") 
08.
Set csvFile = fso.OpenTextFile(csvFilePath,8,True) 
09.
csvFile.WriteLine(VbCrLf & "Ausgelesene Daten vom " & Now & VbCrLf) 
10.
Call main 
11.
MsgBox "fertig" 
12.
 
13.
Sub main() 
14.
Dim folder 
15.
Set folder = fso.GetFolder(fname) 
16.
recFolder(folder) 
17.
 
18.
csvFile.Close 
19.
 
20.
End Sub 
21.
 
22.
 
23.
Sub recFolder(fname) 
24.
Dim subfolder 
25.
csvFile.Write(readacl(fname)) 
26.
For Each subfolder In fname.SubFolders 
27.
recFolder(subfolder) 
28.
Next 
29.
 
30.
End Sub 
31.
 
32.
 
33.
Function readacl(Folder) 
34.
 
35.
readacl = True 
36.
Dim wmi 
37.
Dim Result 
38.
Dim AFlags, FormatType,fss,sts,dce,sd 
39.
 
40.
Result = Folder & ";" 
41.
Set wmi = GetObject("winmgmts:{impersonationLevel=Impersonate,(TakeOwnership)}!\\.\root\cimv2") 
42.
Set fss = wmi.Get("Win32_LogicalFileSecuritySetting='" & fname & "'") 
43.
sts = fss.GetSecurityDescriptor(sd) 
44.
 
45.
For Each dce In sd.dacl 
46.
		Result = Result &  dce.Trustee.Name & ";" 
47.
		Result = Result &   dce.Trustee.SIDString & ";" 
48.
		Select Case hex(dce.AccessMask) 
49.
		'Eine Dokumentation über die AccessMask findest du bei MSDN, ich habe die 3 geläufigsten aufgelistet: 
50.
		Case "1F01FF" 
51.
		FormatType= "Full"	 
52.
		Case "1301BF" 
53.
		FormatType = "Write" 
54.
		Case "1200A9" 
55.
		FormatType = "Read"			 
56.
		Case Else 
57.
		FormatType = "Unspecified" 
58.
		End Select 
59.
		 
60.
		Result = Result & FormatType & ";" 
61.
		 
62.
		'Eine Dokumentation über die AceFlags findest du bei MSDN, ich habe dir ein paar Bsp gelistet:		 
63.
		Select Case Hex(dce.AceFlags) 
64.
		Case "0" 
65.
		AFlags = "NUR DIESER ORDNER ---- nicht geerbt" 
66.
		Case "3" 
67.
		AFlags = "diesen Ordner, Unterordner und Dateien  ---- nicht geerbt" 
68.
		Case "13" 
69.
		AFlags = "NUR DIESER ORDNER ---- geerbt" 
70.
		Case "1B" 
71.
		AFlags = "Nur Unterordner und Dateien --- geerbt" 
72.
		End Select		 
73.
	    Result = Result & AFlags & ";" & VbCrLf & ";" 
74.
	     
75.
Next 
76.
Result  = Left(Result,Len(Result)-1) 
77.
readacl =  Result 
78.
End Function 
79.
 
Bei Fragen, einfach stellen bzw nachlesen

Gruss Mono
Bitte warten ..
Mitglied: DieDrohne
20.09.2010 um 10:51 Uhr
Hallo und Danke erstmal,

Ich habe den Code probiert und bekomme immer einer Fehlermeldung. Er markiert den Pfad und sagt "Fehler beim Kombilieren! Ausserhalb der Prozedure ungültig"

Ich bin total ratlos und meine Kollegen auch. Wir kommen einfach nicht drauf warum es zum Fehler kommt.

Hast du den Code in Excel 2007 probiert gehabt? Kann vielleicht bitte jemand den Code bei sich testen und mir Rückmeldung geben?

Dankeschön.
Bitte warten ..
Mitglied: MonoTone
20.09.2010 um 13:34 Uhr
HI,

das ist ein VB Script.
Dazu muss du den Inhalt in eine Textdatei einfügen, diese mit der Endung .vbs abspeichern und danach ausführen.
Die PFade musst du natürlich anpassen. Am besten baust du dir ein paar Testordner mit verschiedenen Berechtigungen, legst im Script den Pfad auf die Testordner und startest es.
Danach erhältst du eine .csv Datei mit den entsprechenden Ausgaben.

Alternativ kannst du das auch in Excel direkt ausführen. Dazu musst es dir nur nach VBA anpassen und entsprechend aufrufen.
Bitte warten ..
Mitglied: DieDrohne
21.09.2010 um 09:16 Uhr
Hm das ist auch eine Möglichkeit, nur schein ich da zu blöd zu sein. Selbst die Hilfeseite von Microsoft hat mir nicht weitergeholfen.

Zu Hause geht das Script auf jeden Fall, nur ich bin hier auf Arbeit sehr eingeschränkt in meine Möglichkeiten. Sicherheitsgründe halt und dazu gehört leider das VBS nicht ausgeführt werden darf, VBA über Excel allerdings schon.

Findet sich ein findiger Programmierer der mir weiterhelfen kann und den Script anpasst? Das wäre superlieb!

Liebe Grüße
Bitte warten ..
Mitglied: DieDrohne
28.09.2010 um 11:31 Uhr
Schade um den schönen Code. Auf Arbeit darf kein VBScript ausgeführt werden und somit darf ich den Code da oben nicht nutzen. Nur VBA. Hatte mich nochmal rückversichert, ob es keine andere Möglichkeit gibt.

Schade.
Bitte warten ..
Mitglied: 76109
28.09.2010 um 11:55 Uhr
Hallo DieDrohne!

Dann versuch mal, ob Du hiermit weiterkommst

Der nachfolgende VBA-Code gestattet eine flexible Erstellung einer Csv-Datei mit den entsprechenden Folder-Zugriffsrechten.

Die ersten Zeilen mit ihren Konstanten sollten selbsterklärend sein.

Erklärung zu den Definitionen der Zugriffs-Konstanten:

Die Konstanten-Namen:
AF steht für AccessFlags, AT für Access-Type und AM für AccessMask und die Nummer dahinter ist die dazugehörige Bit-Nummer.

Die Konstanten mit einem x und einer Nummer z.B. AMx1 (Hex 1F01FF) definieren Bit-Masken und können beliebig definiert werden, wobei die Bezeichnungen nach den ersten beiden Buchstaben frei wählbar sind.

An dieser Stelle sei schonmal zu erwähnen, dass in der Definition nach dem "="-Zeichen im ersten Token z.B. "AM?;" eine Besonderheit zu beachten ist, die im Code eine wichtige Rolle spielt. Und zwar wird anhand des 3. Zeichens im Code unterschieden, ob ein Bit-Test (& alias And) oder ein Vergleich (= alias Compare) durchgeführt wird. Sprich ein Bit-Wert mit And und eine Bit-Maske oder der Wert 0 mit Compare testen. Hierbei ist ebenfalls zu beachten, dass der Vergleich (Compare) Vorang vor einem Bit-Test (And) hat, was bedeutet, wenn eine Bit-Maske True ist, dann wird kein Bit-Test durchgeführt.

Die Konstanten nach Wunsch registrieren:
Die Konstanten AFxx, ATxx, AMxx werden nun zwecks Flexibilität im Code in dem Array CsvListe eingetragen, in der sie ausgegeben werden sollen. D.h. das nur die Konstanten, die in der CsvListe eingetragen sind und in der Reihenfolge wie sie eingetragen sind, in die Csv-Datei geschrieben werden, wobei allerdings die ersten 4 Spalten schon mit "Pfad;Erstellt;Benutzer;SID-String" vordefiniert sind.

Anhand der CsvListe werden die Werte, die sich hinter dem "="-Zeichen befinden in einem Dictionary-Object registriert. D.h. es wird ein Schlüssel (Key/ID) mit einem dazugehörigen Wert (Item) erzeugt.

Der Eintrag für z.B. AM02 = "AM&;&H00000004;TitelText" würde dann so aussehen: Key = "AM&00000004 + Item = "00000004" und der wahlfreie TitelText wird in das Überschrift-Array Csv-Titel übernommen und als Überschriftzeile in die Csv-Datei geschrieben.

Hoffe das es bis hierher einigermaßen verständlich war, ansonsten nachfragen

Quellcode in ein Modul einfügen und einfach mal starten und die Csv-Datei anschauen und danach entsprechende Anpassungen vornehmen.
01.
    Option Explicit 
02.
    Option Compare Text 
03.
     
04.
    Const FoldersPath = "D:\Temp"                           'Start-Ordner 
05.
     
06.
    Const CsvFileName = "FolderUserRights.csv"              'Wird im Workbook-Pfad gespeichert 
07.
    
08.
    Const CsvDelim = ";"                                    'Beliebiges Trennzeichen festlegen 
09.
  '______________________________________________________________________________________ 
10.
     
11.
   'Spalte 1-4 = Path, Erstellungsdatum, Gruppe/Benutzername, G/B-Name-SID 
12.
    Const CsvTextReserved = 4 
13.
    
14.
   'Control-Flag Infos verfügbar 
15.
    Const SE_DACL_PRESENT = &H4 
16.
     
17.
   'Zugriffs-Flags, TitelText nach belieben festlegen 
18.
    Const AF00 = "AF&;&H01;TitelText"             'OBJECT_INHERIT_ACE 
19.
    Const AF01 = "AF&;&H02;TitelText"             'CONTAINER_INHERIT_ACE 
20.
    Const AF02 = "AF&;&H04;TitelText"             'NO_PROPOGATE_INHERIT_ACE 
21.
    Const AF03 = "AF&;&H08;TitelText"             'INHERIT_ONLY_ACE 
22.
    Const AF04 = "AF&;&H10;TitelText"             'INHERIT_ACE" 
23.
     
24.
   'Zugriffs-Type 
25.
    Const ATx0 = "AT=;&H00;TitelText"             'ACCESS_ALLOWED_ACE_TYPE 
26.
     
27.
    Const AT00 = "AT&;&H01;TitelText"             'ACCESS_DENIED_ACE_TYPE 
28.
    Const AT01 = "AT&;&H02;TitelText"             'AUDIT 
29.
       
30.
   'Zugriffsrechte: Objektspezifisch 
31.
    Const AM00 = "AM&;&H00000001;TitelText"       'DIR_LIST_DIRECTORY/FILE_READ_DATA 
32.
    Const AM01 = "AM&;&H00000002;TitelText"       'DIR_ADD_FILE/FILE_WRITE_DATA 
33.
    Const AM02 = "AM&;&H00000004;TitelText"       'DIR_ADD_SUBDIRECTORY/FILE_APPEND_DATA 
34.
    Const AM03 = "AM&;&H00000008;TitelText"       'READ_NAMED_ATTRIBUTS 
35.
    Const AM04 = "AM&;&H00000010;TitelText"       'WRITE_NAMED_ATTRIBUTS 
36.
    Const AM05 = "AM&;&H00000020;TitelText"       'EXECUTE 
37.
    Const AM06 = "AM&;&H00000040;TitelText"       'DELETE_CHILD 
38.
    Const AM07 = "AM&;&H00000080;TitelText"       'READ_ATTRIBUTES 
39.
    Const AM08 = "AM&;&H00000100;TitelText"       'WRITE_ATTRIBUTES 
40.
     
41.
    Const AMx1 = "AM=;&H001F01FF;TitelText"       'FILE_ALL_ACCESS" 
42.
     
43.
    'Zugriffsrechte: Standard --> Zugriffsrechte auf Objektspezifisch 
44.
    Const AM16 = "AM&;&H00010000;TitelText"       'DELETE 
45.
    Const AM17 = "AM&;&H00020000;TitelText"       'READ_ACL 
46.
    Const AM18 = "AM&;&H00040000;TitelText"       'WRITE_ACL 
47.
    Const AM19 = "AM&;&H00080000;TitelText"       'WRITE_OWNER 
48.
    Const AM20 = "AM&;&H00100000;TitelText"       'SYNCHRONIZE 
49.
     
50.
    'Zugriffsrechte: Security-Descriptor SACL (System Access Control List) 
51.
    Const AM24 = "AM&;&H01000000;TitelText"       'ACCESS_SYSTEM_SECURITY 
52.
     
53.
    'Zugriffsrechte Erweitert --> Zugriffsrechte auf Standard/Objektspezifisch 
54.
    Const AM28 = "AM&;&H10000000;TitelText"       'GENERIC_ALL 
55.
    Const AM29 = "AM&;&H20000000;TitelText"       'GENERIC_EXECUTE 
56.
    Const AM30 = "AM&;&H40000000;TitelText"       'GENERIC_WRITE 
57.
    Const AM31 = "AM&;&H80000000;TitelText"       'GENERIC_READ 
58.
'______________________________________________________________________________________ 
59.
     
60.
    Const Msg0 = "Der Vorgang kann je nach Anzahl der Ordner einige Minuten dauern!" 
61.
    Const Msg1 = "Der Csv-Export ist abgeschlossen." 
62.
     
63.
    Dim Fso As Object, ACL As Object, objWMIService As Object, CsvFile As Object 
64.
    Dim CsvText As Variant, CsvSize As Integer 
65.
 
66.
Sub GetFoldersAccessRights() 
67.
    Dim CsvListe As Variant, CsvTitel As Variant, Token As Variant, i As Integer 
68.
     
69.
    If MsgBox(Msg0, vbOKCancel Or vbInformation, "Zugriffsrechte...") = vbCancel Then Exit Sub 
70.
     
71.
    CsvListe = Array(AF00, AF01, AF02, AF03, AF04, ATx0, AT00, AT01, AM00, AM01, AM02, AM03, AM04, AM05, AM06, AM07, AM08, AM16, AM17, AM18, AM19, AM20, AMx1) 
72.
 
73.
    CsvSize = UBound(CsvListe) + CsvTextReserved 
74.
     
75.
    ReDim CsvText(CsvSize):  ReDim CsvTitel(CsvSize) 
76.
     
77.
    Set ACL = CreateObject("Scripting.Dictionary") 
78.
     
79.
    CsvTitel(0) = "Pfad" 
80.
    CsvTitel(1) = "Erstellt" 
81.
    CsvTitel(2) = "Benutzer" 
82.
    CsvTitel(3) = "SID" 
83.
     
84.
    For i = 0 To UBound(CsvListe) 
85.
        Token = Split(CsvListe(i), ";") 
86.
        ACL.Add Token(0) & Hex(Token(1)), i + CsvTextReserved & ";" & Token(1) 
87.
        CsvTitel(i + CsvTextReserved) = Token(2) 
88.
    Next 
89.
 
90.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
91.
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=Impersonate,(TakeOwnership)}!\\.\root\cimv2") 
92.
     
93.
    Set CsvFile = Fso.CreateTextFile(ThisWorkbook.Path & "\" & CsvFileName) 
94.
     
95.
    CsvFile.WriteLine Join(CsvTitel, ";") 
96.
     
97.
    Call GetFolder(Fso.GetFolder(FoldersPath)):   CsvFile.Close 
98.
     
99.
    MsgBox Msg1, vbInformation, "Csv-Export..." 
100.
End Sub 
101.
 
102.
Private Sub GetFolder(ByRef Folder) 
103.
    Dim Subfolder As Object, i As Integer 
104.
     
105.
    CsvText(0) = Folder.Path 
106.
     
107.
    If Folder.Name = "" Then 
108.
        CsvText(1) = "" 
109.
    Else 
110.
        CsvText(1) = FormatDateTime(Folder.DateCreated, vbShortDate) 
111.
    End If 
112.
             
113.
    Call GetSecuritySettings(Folder) 
114.
     
115.
    On Error Resume Next 
116.
     
117.
    For Each Subfolder In Folder.SubFolders 
118.
        If Err.Number = 0 Then 
119.
            Call GetFolder(Subfolder) 
120.
        Else 
121.
            Err.Clear 
122.
            Call WriteCsvFile("Zugriff verweigert") 
123.
        End If 
124.
    Next 
125.
End Sub 
126.
 
127.
Private Sub GetSecuritySettings(ByRef Folder) 
128.
    Dim objFSS As Object, objSD As Object, objACL As Variant 
129.
    Dim LastName As String, DoWrite As Boolean, i As Integer 
130.
     
131.
    On Error Resume Next 
132.
     
133.
    Set objFSS = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & Folder & "'") 
134.
     
135.
    If Err.Number <> 0 Then 
136.
        Call WriteCsvFile("Nicht verfügbar"):  Exit Sub 
137.
    End If 
138.
     
139.
    On Error GoTo 0 
140.
     
141.
    If objFSS.GetSecurityDescriptor(objSD) = 0 Then 
142.
        If (objSD.ControlFlags And SE_DACL_PRESENT) <> 0 Then 
143.
            For Each objACL In objSD.DACL 
144.
                With objACL 
145.
                    CsvText(2) = .Trustee.Name 
146.
                    CsvText(3) = .Trustee.SIDString 
147.
                         
148.
                    For i = 4 To CsvSize:  CsvText(i) = "":  Next 
149.
                     
150.
                    Call SetSecuritySettings("AM", .AccessMask) 
151.
                    Call SetSecuritySettings("AF", .AceFlags) 
152.
                    Call SetSecuritySettings("AT", .AceType) 
153.
                        
154.
                    CsvFile.WriteLine Join(CsvText, CsvDelim) 
155.
                End With 
156.
            Next 
157.
        Else 
158.
            Call WriteCsvFile("Nicht verfügbar") 
159.
        End If 
160.
    Else 
161.
        Call WriteCsvFile("Nicht verfügbar") 
162.
    End If 
163.
End Sub 
164.
 
165.
Private Sub SetSecuritySettings(ByRef Target, ByVal Value) 
166.
    Dim Key As Variant, Token As Variant 
167.
     
168.
    If ACL.Exists(Target & "=" & Hex(Value)) Then 
169.
        Token = Split(ACL.Item(Target & "=" & Hex(Value)), ";") 
170.
        CsvText(Token(0)) = "x" 
171.
    Else 
172.
        For Each Key In ACL.Keys 
173.
            If Left(Key, 3) = Target & "&" Then 
174.
                Token = Split(ACL.Item(Key), ";") 
175.
                If (Value And CLng(Token(1))) Then CsvText(Token(0)) = "x" 
176.
            End If 
177.
        Next 
178.
    End If 
179.
End Sub 
180.
 
181.
Private Sub WriteCsvFile(ByRef Text) 
182.
    Dim i As Integer 
183.
 
184.
    CsvText(2) = Text 
185.
     
186.
    For i = 3 To CsvSize:  CsvText(i) = "":  Next 
187.
     
188.
    CsvFile.WriteLine Join(CsvText, CsvDelim) 
189.
End Sub
Gruß Dieter

[edit] geändert [/edit]
Bitte warten ..
Mitglied: DieDrohne
29.09.2010 um 08:28 Uhr
Erstmal vielen vielen Dank und es funktioniert fast perfekt. Nur eine Frage:

Ich habe nur ein Problem mit
01.
Const CsvAusgabe = "System, Administratoren, Benutzer"  'Csv-Daten ausgeben für?
.

Wenn ich die Abfrage starte, steht bei Benutzer entweder nichts oder Administrator.
Wenn ich meinen kompletten Namen dort eintrage, also nach dem Format "MustermannM@domäne.de" dann gibt er mich auch aus. Wildcards wie * funktionieren wohl nicht? Also das er mir einfach jeden Benutzer für die Ordner ausgibt? Oder muss ich eine Liste schreiben mit allen Benutzern und diese muss er dann nach und nach abarbeiten?

Schöner wäre es natürlich wenn er einfach alle ausgibt.


P.S.: Was mir grad noch aufgefallen ist. Egal welchen Startordner ich nehme, es steht in den Zeilen 2-4 genau dasselbe drin. Also er wiederholt die Zeile 2 noch 2 mal und dann geht er erst weiter.
Bitte warten ..
Mitglied: 76109
29.09.2010 um 10:34 Uhr
Hallo DieDrohne!

Setze mal in der Codezeile 115 und Codezeile 135 ein Kommentarzeichen (Hochkomma) davor.

Zitat von DieDrohne:
P.S.: Was mir grad noch aufgefallen ist. Egal welchen Startordner ich nehme, es steht in den Zeilen 2-4 genau dasselbe drin. Also
er wiederholt die Zeile 2 noch 2 mal und dann geht er erst weiter.
Das kann ich für den Moment leider nicht nachvollziehen

Gruß Dieter
Bitte warten ..
Mitglied: DieDrohne
29.09.2010 um 13:15 Uhr
Hallo,

Ich habs rausgenommen und jetzt listet er mir alle auf, ok er versuchts. Keine Ahnung warum, aber er bricht bei übergeordneten Ordnern bei 1-2 Einträgen ab und untergeordnete bei 2 Einträgen und geht dann schon zum nächsten Ordner.

Standardmäßig sind aber ca. 5-6 Sicherheitsgruppen eingetragen + eventuell einzelne Benutzer.

Kann ich irgendwo einstellen, wie oft er durchläuft oder macht er das von sich aus.

Und noch ne Frage, ich habe sehr viele Ordner, kann es zu einem Überlauf kommen wo er dann abschaltet und mir eine Meldung ausgibt "Vorgang abgebrochen"?

Gruß
André
Bitte warten ..
Mitglied: DieDrohne
29.09.2010 um 13:33 Uhr
So habe jetzt wieder die Fehlermeldung:

Ungültiger Objektpfad. Tritt nach ca. 10 Minuten durchlaufen erst auf.

Nach dem ich auf Debuggen gegangen bin, führte er mich zur Zeile:

01.
    Set objFSS = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & Folder & "'")
Eine Idee?
Bitte warten ..
Mitglied: 76109
29.09.2010 um 18:39 Uhr
Hallo DieDrohne!

Zitat von DieDrohne:
So habe jetzt wieder die Fehlermeldung:
Ungültiger Objektpfad. Tritt nach ca. 10 Minuten durchlaufen erst auf.

Nach dem ich auf Debuggen gegangen bin, führte er mich zur Zeile:
Set objFSS = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & Folder & "'")

Ersetze die Codezeile 107 mal durch diese Codezeilen, die beim Auftreten des Fehlers den betreffenden Ordner-Pfad in einer MsgBox anzeigt:
01.
    On Error Resume Next 
02.
     
03.
    Set objFSS = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & Folder & "'") 
04.
     
05.
    If Err.Number <> 0 Then MsgBox Folder 
06.
     
07.
    On Error GoTo 0
Gruß Dieter

PS. Den Teil Mit Csv-Ausgabe (Benutzer...) habe ich im Code (oben) entfernt
Bitte warten ..
Mitglied: 76109
29.09.2010 um 18:55 Uhr
Hallo DieDrohne!

Zitat von DieDrohne:
Ich habs rausgenommen und jetzt listet er mir alle auf, ok er versuchts. Keine Ahnung warum, aber er bricht bei
übergeordneten Ordnern bei 1-2 Einträgen ab und untergeordnete bei 2 Einträgen und geht dann schon zum
nächsten Ordner.
Kommt da irgendeine Meldung "Zugriff verweigert" sowas in der Art?

Kann ich irgendwo einstellen, wie oft er durchläuft oder macht er das von sich aus.
Verstehe ich jetzt irgendwie nicht so ganz?

Und noch ne Frage, ich habe sehr viele Ordner, kann es zu einem Überlauf kommen wo er dann abschaltet und mir eine Meldung
ausgibt "Vorgang abgebrochen"?
Das sollte meines Wissens nicht passieren?

Gruß Dieter
Bitte warten ..
Mitglied: DieDrohne
29.09.2010 um 22:24 Uhr
Hi,

Ja "Zugriff verweigert" kam, nach der Änderung auf alle anzeigen, kam dann irgendwann die Meldung "Vorgang abgebrochen".

Gruß
André
Bitte warten ..
Mitglied: 76109
29.09.2010 um 23:03 Uhr
Hallo DieDrohne!

Ok, werde ich morgen eine entsprechende Fehlerbehandlung mit einbauen, wobei diese Ordner dann übersprungen werden.

Gruß Dieter
Bitte warten ..
Mitglied: DieDrohne
30.09.2010 um 10:21 Uhr
Hallo didi1954,

Danke für den angepassten Code. Dadurch konnte ich ermitteln warum er abbrach. Mein Kollege hatte den Ordnernamen mit einem Hochkomma ' versehen gehabt. Dadurch hat er an der Stelle immer abgebrochen.

Ordner umbenannt und jetzt geht es.

Da ist aber immer noch eine Sache die ich nicht verstehe. Er listet mir zu 99% die Ordner auf und gibt 2 eingetragene Benutzer aus. Es sind aber mindestens bei jedem Ordner 7 Sicherheitsgruppen mit unterschiedlichen Rechten eingetragen. Auf manche Ordner müssen noch mehr Kollegen darauf zugreifen, dann werden es auch mal schnell 10-15 noch zusätzlich eingetragene Personen.

Das sieht dann ca. so aus:

Pfad 1ErstellungsdatumGruppe 1Rechte...
Pfad 1ErstellungsdatumGruppe 2Rechte...
Pfad 2ErstellungsdatumGruppe 1Rechte...
Pfad 2ErstellungsdatumGruppe 2Rechte...
Pfad 3ErstellungsdatumGruppe 1Rechte...
Pfad 3ErstellungsdatumGruppe 2Rechte...
Pfad 4ErstellungsdatumGruppe 1Rechte...
Pfad 4ErstellungsdatumGruppe 2Rechte...

usw.

Hast du eine Idee warum er die anderen nicht mit ausgibt?

Gruß
André
Bitte warten ..
Mitglied: 76109
30.09.2010 um 10:55 Uhr
Hallo André!

Den Code habe ich nochmal ab Codezeile 60 komplett geändert.

Dabei wird in der Spalte Benutzer dann bei Zugriffsverweigerung "Zugriff verweigert" eingetragen. In anderen Fällen wird "Nicht verfügbar" eingetragen

Zu Beginn kommt jetzt noch eine MsgBox, die darauf hinweist, dass der Vorgange je nach Ordner-Anzahl einige Minuten dauern kann.

Da ist aber immer noch eine Sache die ich nicht verstehe. Er listet mir zu 99% die Ordner auf und gibt 2 eingetragene Benutzer aus. Es sind aber mindestens bei
jedem Ordner 7 Sicherheitsgruppen mit unterschiedlichen Rechten eingetragen. Auf manche Ordner müssen noch mehr Kollegen darauf zugreifen, dann werden es
auch mal schnell 10-15 noch zusätzlich eingetragene Personen.
Dazu habe ich leider keine Idee

Gruß Dieter
Bitte warten ..
Mitglied: DieDrohne
30.09.2010 um 14:45 Uhr
Hi,

Ich habe jetzt den Code übernommen und durchlaufen lassen. Es geht jetzt irgendwie schneller als vorher ;)

Allerdings habe ich halt immer noch das Problem das er mir max 2 Benutzer ausgibt. Keine ahnung warum, habe es schon Schrittweise durchlaufen lassen. Und dennoch komme ich auf das gleiche Ergebniss. Aus irgendeinem Grund geht er zum nächsten Ordner, obwohl er noch garnicht mit auflisten fertig ist.

Aber wie dem auch sein, LIEBEN DANK für diesen Code!

Gruß
André
Bitte warten ..
Mitglied: DieDrohne
01.10.2010 um 10:32 Uhr
Hallo Dieter,

Fehler gefunden. Ich hab es immer und immer wieder durchlaufen lassen per Einzelschritt bis ich drauf kam.

Der hat die erste Zeile geschrieben und die zweite immer und immer wieder überschrieben bis er alle Benutzer durch hatte. Bei deinem Code gibt es einen kleinen (Denk-)Fehler. Und zwar Zeile 146 und 153 war das DoWrite falsch herum.

So sieht es jetzt bei mir aus:

01.
    If objFSS.GetSecurityDescriptor(objSD) = 0 Then 
02.
        If (objSD.ControlFlags And SE_DACL_PRESENT) <> 0 Then 
03.
            For Each objACL In objSD.DACL 
04.
                With objACL 
05.
                    If .Trustee.Name <> LastName Then 
06.
                        DoWrite = True 
07.
                        LastName = .Trustee.Name 
08.
                        CsvText(2) = .Trustee.Name 
09.
                        CsvText(3) = .Trustee.SIDString 
10.
                         
11.
                        For i = 4 To CsvSize:  CsvText(i) = "":  Next 
12.
                    Else 
13.
                        DoWrite = False 
14.
                    End If 
15.
                         
16.
                    Call SetSecuritySettings("AM", .AccessMask) 
17.
                    Call SetSecuritySettings("AF", .AceFlags) 
18.
                    Call SetSecuritySettings("AT", .AceType) 
19.
                        
20.
                    If DoWrite Then CsvFile.WriteLine Join(CsvText, CsvDelim) 
21.
                End With 
22.
            Next 
23.
        Else 
24.
            Call WriteCsvFile("Nicht verfügbar") 
25.
        End If 
26.
    Else 
27.
        Call WriteCsvFile("Nicht verfügbar") 
28.
    End If
Nun zeigt er mir alle Benutzer bei den Ordnern an und das ist genau das was ich wollte ;)

VIELEN VIELEN DANK!!!!

Gruß André

P.S.: Ich weiß ich bin jetzt frech, aber wenn er das aus Excel heraus eine CSV Datei erstellt, kann man dann das ganze nicht auch so machen, das er das gleich in Excel abspeichert?
Bitte warten ..
Mitglied: 76109
01.10.2010 um 10:48 Uhr
Hallo André!

Aja, danke für den Hinweis Muss ich mir heute Abend oder morgen nochmal ansehen.

Gruß Dieter
Bitte warten ..
Mitglied: 76109
01.10.2010 um 20:54 Uhr
Hallo André!

Also, ich hatte tatsächlich einen Denkfehler

Allerdings stimmt Deine Code-Änderung auch nicht Da fehlen ebenfalls wieder Einträge.

Ich hatte leider nur auf meiner Daten-Partition getestet und da ist es so, dass für System, Admin, Benutzer.. immer 2 Datensätze zurückgegeben werden. Von daher dachte ich, dass dies generell so wäre, was aber leider ein Irtum war. Deswegen hatte ich den Code so geschrieben, das erst mit dem 2. Datensatz eine Zeile in die Csv-Datei geschrieben wird, was in diesem Fall auch funktioniert hat.

Bei einem weiteren Test auf meiner W7-Partition ist mir das leider jetzt erst aufgefallen

Den Code oben habe ich jetzt nochmal so geändert, dass jeder Datensatz in die Csv-Datei geschrieben wird, wobei allerdings für System, Admin... dann teilweise wieder 2 Datensätze (sprich 2 Zeilen) ausgegeben werden.

Gut das ich den Code mal auf meiner W7-Partition hab laufen lassen. Dabei ist mir nämlich erst aufgefallen, dass mein Win7 2 Endlos-Ordnerstrukturen enthält z.B.
C:\Users\Default User\Lokale Einstellungen\Anwendungsdaten\Anwendungsdaten\Anwendungsdaten\Endlos.....
Bei 260 MB mit fast 1 Million Zeilen habe ich dann mal abgebrochen

Nach Behebung des Problems hat das Auslesen meiner Win7-Partition mit ca 26.000 Ordnern ca 15 Minuten gedauert, wobei die Csv-Datei eine Größe von rund 20 MB erreichte (ca 118.000 Zeilen).

Gruß Dieter

[edit] Kommentar aktualisiert [/edit]
Bitte warten ..
Mitglied: DieDrohne
05.10.2010 um 20:18 Uhr
Hallo Dieter.

Ich bin diese woche sehr im Stress auf Arbeit mit anderen Sachen und kann daher erst nächste Woche deinen Code weiter anschauen und bearbeiten. Aktuell funktioniert er super...

Aber da ist immer noch eine Sache, Kann man den umschreiben das er ein 2. Tabellenblatt in der aktuellen Exceldatei automatisch befüllt, ohne den Umweg über eine csv Datei zu machen?

Liebe Grüße
André
Bitte warten ..
Mitglied: 76109
05.10.2010 um 22:02 Uhr
Hallo André!

Zitat von DieDrohne:
Aber da ist immer noch eine Sache, Kann man den umschreiben das er ein 2. Tabellenblatt in der aktuellen Exceldatei automatisch
befüllt, ohne den Umweg über eine csv Datei zu machen?
Ja, dass wäre im Prinzip keine große Sache. Hierbei besteht allerdings, je nach Anzahl der Ordner, die Gefahr eines Überlaufs (Max-Zeilen).

Gruß Dieter
Bitte warten ..
Mitglied: DieDrohne
06.10.2010 um 08:05 Uhr
Hi,

Ich glaub ich habe irgendwo mal ein Script gesehen, wo man bei einer gewissen Anzahl auf ein 2. 3. usw Tabellenblatt weiterschreiben kann. Aber 1 Tabellenblatt reicht auch aus, wenn man ab einem bestimmten Ordner erst anfängt ;)

LG
André
Bitte warten ..
Mitglied: 76109
06.10.2010 um 13:01 Uhr
Hallo André!

Hier der neue Code, der die Daten in die Arbeitsmappe schreibt.

Schritt 1:
Jenachdem, ob die Arbeitsmappe bereits Tabellen beinhaltet oder nicht, muss eine Tabelle mit dem Namen angelegt werden, der der Konstanten SheetName entspricht und am Ende muss die Ziffer 1 stehen z.B Tabelle1, Liste1...

Schritt 2:
Die Konstante StartLine besagt, dass die Rechte ab dieser Zeile eingetragen werden. Die Überschrift wird jedoch in die Zeile 1 eingetragen.

Sofern eine Tabelle mit dem Namen (SheetName) existiert, wobei ich jetzt als Beispiel den Namen Rechte1 verwende, dann ist der weitere Ablauf in etwa so:
Beim Start des Makro, wird eine CleanUp-Funktion durchgeführt, in der alle Sheets, die dem Namen Rechte entsprechen - mit Ausnahme von Rechte1 - gelöscht werden.
Im weiteren Verlauf werden je nach Bedarf, automatisch weitere Sheets in fortlaufender Reihenfolge und hintereinander angelegt z.B. Rechte1, Rechte2 usw.

In der Schluss-Meldung wird noch zusätzlich die Gesamtzahl der eingelesenen Ordner mit ausgegeben.

Neuer Code:
01.
       Option Explicit 
02.
    Option Compare Text 
03.
     
04.
    Const FoldersPath = "C:\"       'Start-Ordner 
05.
     
06.
    Const SheetName = "Rechte1"     'Tabellenname wahlweise, am Ende muss die Ziffer 1 stehen 
07.
     
08.
    Const StartLine = 2             'Ab Zeile 
09.
'______________________________________________________________________________________ 
10.
     
11.
   'Spalte 1-4 = Path, Erstellungsdatum, Gruppe/Benutzername, G/B-Name-SID 
12.
    Const TextReserved = 4 
13.
    
14.
   'Control-Flag Infos verfügbar 
15.
    Const SE_DACL_PRESENT = &H4 
16.
     
17.
   'Zugriffs-Flags, TitelText nach belieben festlegen 
18.
    Const AF00 = "AF&;&H01;TitelText"             'OBJECT_INHERIT_ACE 
19.
    Const AF01 = "AF&;&H02;TitelText"             'CONTAINER_INHERIT_ACE 
20.
    Const AF02 = "AF&;&H04;TitelText"             'NO_PROPOGATE_INHERIT_ACE 
21.
    Const AF03 = "AF&;&H08;TitelText"             'INHERIT_ONLY_ACE 
22.
    Const AF04 = "AF&;&H10;TitelText"             'INHERIT_ACE" 
23.
     
24.
   'Zugriffs-Type 
25.
    Const ATx0 = "AT=;&H00;TitelText"             'ACCESS_ALLOWED_ACE_TYPE 
26.
     
27.
    Const AT00 = "AT&;&H01;TitelText"             'ACCESS_DENIED_ACE_TYPE 
28.
    Const AT01 = "AT&;&H02;TitelText"             'AUDIT 
29.
       
30.
   'Zugriffsrechte: Objektspezifisch 
31.
    Const AM00 = "AM&;&H00000001;TitelText"       'DIR_LIST_DIRECTORY/FILE_READ_DATA 
32.
    Const AM01 = "AM&;&H00000002;TitelText"       'DIR_ADD_FILE/FILE_WRITE_DATA 
33.
    Const AM02 = "AM&;&H00000004;TitelText"       'DIR_ADD_SUBDIRECTORY/FILE_APPEND_DATA 
34.
    Const AM03 = "AM&;&H00000008;TitelText"       'READ_NAMED_ATTRIBUTS 
35.
    Const AM04 = "AM&;&H00000010;TitelText"       'WRITE_NAMED_ATTRIBUTS 
36.
    Const AM05 = "AM&;&H00000020;TitelText"       'EXECUTE 
37.
    Const AM06 = "AM&;&H00000040;TitelText"       'DELETE_CHILD 
38.
    Const AM07 = "AM&;&H00000080;TitelText"       'READ_ATTRIBUTES 
39.
    Const AM08 = "AM&;&H00000100;TitelText"       'WRITE_ATTRIBUTES 
40.
     
41.
    Const AMx1 = "AM=;&H001F01FF;TitelText"       'FILE_ALL_ACCESS" 
42.
     
43.
    'Zugriffsrechte: Standard --> Zugriffsrechte auf Objektspezifisch 
44.
    Const AM16 = "AM&;&H00010000;TitelText"       'DELETE 
45.
    Const AM17 = "AM&;&H00020000;TitelText"       'READ_ACL 
46.
    Const AM18 = "AM&;&H00040000;TitelText"       'WRITE_ACL 
47.
    Const AM19 = "AM&;&H00080000;TitelText"       'WRITE_OWNER 
48.
    Const AM20 = "AM&;&H00100000;TitelText"       'SYNCHRONIZE 
49.
     
50.
    'Zugriffsrechte: Security-Descriptor SACL (System Access Control List) 
51.
    Const AM24 = "AM&;&H01000000;TitelText"       'ACCESS_SYSTEM_SECURITY 
52.
     
53.
    'Zugriffsrechte Erweitert --> Zugriffsrechte auf Standard/Objektspezifisch 
54.
    Const AM28 = "AM&;&H10000000;TitelText"       'GENERIC_ALL 
55.
    Const AM29 = "AM&;&H20000000;TitelText"       'GENERIC_EXECUTE 
56.
    Const AM30 = "AM&;&H40000000;TitelText"       'GENERIC_WRITE 
57.
    Const AM31 = "AM&;&H80000000;TitelText"       'GENERIC_READ 
58.
'______________________________________________________________________________________ 
59.
     
60.
    Const Msg0 = "Der Vorgang kann je nach Anzahl der Ordner einige Minuten dauern!" 
61.
    Const Msg1 = "Das Einlesen der Rechte aus %1 Ordnern ist abgeschlossen." 
62.
     
63.
    Dim Fso As Object, ACL As Object, objWMIService As Object, TextLine As Variant, TitelLine As Variant 
64.
    Dim TextSize As Long, CellSize As Long, FoldersCount As Long, NewLine As Long, EndLine As Long 
65.
 
66.
Sub GetFoldersAccessRights() 
67.
    Dim TextList As Variant, Token As Variant, i As Integer 
68.
     
69.
    If MsgBox(Msg0, vbOKCancel Or vbInformation, "Zugriffsrechte...") = vbCancel Then Exit Sub 
70.
     
71.
    TextList = Array(AF00, AF01, AF02, AF03, AF04, ATx0, AT00, AT01, AM00, AM01, AM02, AM03, AM04, AM05, AM06, AM07, AM08, AM16, AM17, AM18, AM19, AM20, AMx1) 
72.
 
73.
    TextSize = UBound(TextList) + TextReserved:  CellSize = TextSize + 1 
74.
     
75.
    ReDim TextLine(TextSize):  ReDim TitelLine(TextSize) 
76.
     
77.
    Set ACL = CreateObject("Scripting.Dictionary") 
78.
     
79.
    TitelLine(0) = "Pfad" 
80.
    TitelLine(1) = "Erstellt" 
81.
    TitelLine(2) = "Benutzer" 
82.
    TitelLine(3) = "SID" 
83.
     
84.
    For i = 0 To UBound(TextList) 
85.
        Token = Split(TextList(i), ";") 
86.
        ACL.Add Token(0) & Hex(Token(1)), i + TextReserved & ";" & Token(1) 
87.
        TitelLine(i + TextReserved) = Token(2) 
88.
    Next 
89.
 
90.
    Set Fso = CreateObject("Scripting.FileSystemObject") 
91.
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=Impersonate,(TakeOwnership)}!\\.\root\cimv2") 
92.
     
93.
    FoldersCount = 0 
94.
     
95.
    Call CleanUpSheets 
96.
     
97.
    Range(Range("A1"), Cells(1, CellSize)) = TitelLine 
98.
     
99.
    Call GetFolder(Fso.GetFolder(FoldersPath)) 
100.
     
101.
    MsgBox Replace(Msg1, "%1", FoldersCount), vbInformation, "Rechte einlesen..." 
102.
End Sub 
103.
 
104.
Private Sub GetFolder(ByRef Folder) 
105.
    Dim Subfolder As Object, i As Integer 
106.
     
107.
    TextLine(0) = Folder.Path 
108.
     
109.
    If Folder.Name = "" Then 
110.
        TextLine(1) = "" 
111.
    Else 
112.
        TextLine(1) = FormatDateTime(Folder.DateCreated, vbShortDate) 
113.
    End If 
114.
             
115.
    Call GetSecuritySettings(Folder) 
116.
     
117.
    On Error Resume Next 
118.
     
119.
    For Each Subfolder In Folder.SubFolders 
120.
        If Err.Number = 0 Then 
121.
            Call GetFolder(Subfolder) 
122.
        Else 
123.
            Err.Clear 
124.
            Call WriteText("Zugriff verweigert") 
125.
        End If 
126.
    Next 
127.
End Sub 
128.
 
129.
Private Sub GetSecuritySettings(ByRef Folder) 
130.
    Dim objFSS As Object, objSD As Object, objACL As Variant 
131.
    Dim LastName As String, DoWrite As Boolean, i As Integer 
132.
     
133.
    FoldersCount = FoldersCount + 1 
134.
     
135.
    On Error Resume Next 
136.
     
137.
    Set objFSS = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & Folder & "'") 
138.
     
139.
    If Err.Number <> 0 Then 
140.
        Call WriteText("Nicht verfügbar"):  Exit Sub 
141.
    End If 
142.
     
143.
    On Error GoTo 0 
144.
     
145.
    If objFSS.GetSecurityDescriptor(objSD) = 0 Then 
146.
        If (objSD.ControlFlags And SE_DACL_PRESENT) <> 0 Then 
147.
            For Each objACL In objSD.DACL 
148.
                With objACL 
149.
                    TextLine(2) = .Trustee.Name 
150.
                    TextLine(3) = .Trustee.SIDString 
151.
                         
152.
                    For i = 4 To TextSize:  TextLine(i) = "":  Next 
153.
                     
154.
                    Call SetSecuritySettings("AM", .AccessMask) 
155.
                    Call SetSecuritySettings("AF", .AceFlags) 
156.
                    Call SetSecuritySettings("AT", .AceType) 
157.
                        
158.
                    If NewLine > EndLine Then Call CreateNewSheet 
159.
                     
160.
                    Range(Cells(NewLine, 1), Cells(NewLine, CellSize)) = TextLine: NewLine = NewLine + 1 
161.
                End With 
162.
            Next 
163.
        Else 
164.
            Call WriteText("Nicht verfügbar") 
165.
        End If 
166.
    Else 
167.
        Call WriteText("Nicht verfügbar") 
168.
    End If 
169.
End Sub 
170.
 
171.
Private Sub SetSecuritySettings(ByRef Target, ByVal Value) 
172.
    Dim Key As Variant, Token As Variant 
173.
     
174.
    If ACL.Exists(Target & "=" & Hex(Value)) Then 
175.
        Token = Split(ACL.Item(Target & "=" & Hex(Value)), ";") 
176.
        TextLine(Token(0)) = "x" 
177.
    Else 
178.
        For Each Key In ACL.Keys 
179.
            If Left(Key, 3) = Target & "&" Then 
180.
                Token = Split(ACL.Item(Key), ";") 
181.
                If (Value And CLng(Token(1))) Then TextLine(Token(0)) = "x" 
182.
            End If 
183.
        Next 
184.
    End If 
185.
End Sub 
186.
 
187.
Private Sub WriteText(ByRef Text) 
188.
    Dim i As Integer 
189.
 
190.
    TextLine(2) = Text 
191.
     
192.
    For i = 3 To TextSize:  TextLine(i) = "":  Next 
193.
     
194.
    If NewLine > EndLine Then Call CreateNewSheet 
195.
                     
196.
    Range(Cells(NewLine, 1), Cells(NewLine, CellSize)) = TextLine: NewLine = NewLine + 1 
197.
End Sub 
198.
 
199.
Private Sub CleanUpSheets() 
200.
    Dim Wks As Worksheet 
201.
     
202.
    ThisWorkbook.Activate 
203.
     
204.
    Sheets(SheetName).Cells.Clear 
205.
     
206.
    For Each Wks In Sheets 
207.
        If Wks.Name Like Left(SheetName, Len(SheetName) - 1) & "[!1]" Then 
208.
            Application.DisplayAlerts = False 
209.
            Wks.Delete 
210.
            Application.DisplayAlerts = True 
211.
        End If 
212.
    Next 
213.
    Sheets(SheetName).Activate:  Range("A1").Select 
214.
     
215.
    NewLine = StartLine:  EndLine = Rows.Count 
216.
End Sub 
217.
 
218.
Private Sub CreateNewSheet() 
219.
    Dim LastNumber As Integer, LastName As String 
220.
     
221.
    LastName = ActiveSheet.Name 
222.
    LastNumber = Right(LastName, 1) 
223.
     
224.
    Sheets.Add After:=ActiveSheet 
225.
     
226.
    ActiveSheet.Name = Replace(LastName, LastNumber, LastNumber + 1) 
227.
     
228.
    Range(Range("A1"), Cells(1, CellSize)) = TitelLine 
229.
     
230.
    NewLine = StartLine 
231.
End Sub
Gruß Dieter
Bitte warten ..
Mitglied: DieDrohne
07.10.2010 um 10:39 Uhr
Hallo Dieter!

Du bist der Größte!

Es funktioniert alles ohne Probleme und dafür sage ich schonmal tausend Dank!

Jetzt muss ich nur noch ein wenig Feinarbeit betreiben und dann habe ich genau das, was ich wollte!

Danke Danke Danke!

Gruß
André
Bitte warten ..
Mitglied: 76109
07.10.2010 um 17:11 Uhr
Hallo André!

Zitat von DieDrohne:
Es funktioniert alles ohne Probleme und dafür sage ich schonmal tausend Dank!
Freut mich zu hören
Danke Danke Danke!
Yepp, gern geschehen

Dann fehlt ja nur noch das grüne Gelöst-Häkchen

Gruß Dieter
Bitte warten ..
Mitglied: ZurigoX
14.11.2012 um 15:17 Uhr
Hallo zusammen

Da hier schon seit mehr als zwei Jahren Funkstille herrscht, bin ich mir nicht sicher, ob ich eine Antwort bekomme. Ich versuchs mal und bin dankbar, wenn mir jemand, der mehr von der Sache verstehet, weiterhilft.
Das Script hier würde genau das machen, das ich benötige. Lokal funktioniert das auch 1A. Sobald ich es aber auf Netzlaufwerke anwende, bekommen ich beim Benutzer nur ein "Nicht verfügbar". Dabei spielt es keine Rolle, ob ich es von meinem Rechner aus mache, oder ob es auf einem Server ausgeführt wird. Was mach ich falsch.

Beste Dank im Voraus

ZurigoX
Bitte warten ..
Neuester Wissensbeitrag
Internet

Unbemerkt - Telekom Netzumschaltung! - BNG - Broadband Network Gateway

(3)

Erfahrungsbericht von ashnod zum Thema Internet ...

Ähnliche Inhalte
Outlook & Mail
gelöst Email Anhänge speichern VB Script aber nur bestimmte Dateitypen (Outlook) (4)

Frage von LindeUnimog zum Thema Outlook & Mail ...

VB for Applications
gelöst VB Script rekursiv statt nur ein Ordner (4)

Frage von Saschaaaaa zum Thema VB for Applications ...

VB for Applications
gelöst VB Script nach gefundenem Wort die nächsten 4 Zeichen ersetzten (2)

Frage von deutsch73 zum Thema VB for Applications ...

Batch & Shell
gelöst Verschieben von Ordnern mittels Excelliste und Script (6)

Frage von StrgAltEntf zum Thema Batch & Shell ...

Heiß diskutierte Inhalte
Windows Server
Outlook Verbindungsversuch mit Exchange (15)

Frage von xbast1x zum Thema Windows Server ...

Microsoft Office
Keine Updates für Office 2016 (12)

Frage von Motte990 zum Thema Microsoft Office ...

Grafikkarten & Monitore
Tonprobleme bei Fernseher mit angeschlossenem Laptop über HDMI (11)

Frage von Y3shix zum Thema Grafikkarten & Monitore ...