Probleme beim Übernehmen von Variablen aus einer Zelle

Hallo,

ich habe ein Problem mit dem Auslesen einer Zelle. Ich möchte über einen Knopf einen Pfad wählen können. Dieser wird beispielsweise in Zelle B3 hinterlegt. Das Programm, welches ich aus irgend einem Forum gefunden habe, soll diesen Pfad welcher in B3 im Blatt "Einstellungen" steht nehmen und auswerten. Die Ergebnisse sollen dann im Blatt "Reche1" abgelegt werden.

Ich muss gestehen, dass ich von VB keine große Ahnung habe. Ich lese mich gerade ein.

Letzten Endes wollte ich eine Tabelle haben, bei dem in Tab Rechte die Benutzerrechte und im Tab Speicher der Speicherverbrauch aufgelistet wird.

Ich kann ja mal den Code anhängen. Das mit den Rechten funktioniert, wenn ich der Variable direkt den Pfad gebe, lasse ich das aus Zelle B3 übergeben, funktioniert das nicht.

    Option Explicit
    Option Compare Text
    Public FoldersPath As String    'Start-Ordner  
    
    Const SheetName = "Rechte1"     'Tabellenname wahlweise, am Ende muss die Ziffer 1 stehen  
    
    Const StartLine = 2             'Ab Zeile  

   'Spalte 1-4 = Path, Erstellungsdatum, Gruppe/Benutzername, G/B-Name-SID  

    Const TextReserved = 4

    'Control-Flag Infos verf?gbar  

    Const SE_DACL_PRESENT = &H4

       'Zugriffs-Flags, TitelText nach belieben festlegen  

    Const AF00 = "AF&;&H01;TitelText"             'OBJECT_INHERIT_ACE  
    Const AF01 = "AF&;&H02;TitelText"             'CONTAINER_INHERIT_ACE  
    Const AF02 = "AF&;&H04;TitelText"             'NO_PROPOGATE_INHERIT_ACE  
    Const AF03 = "AF&;&H08;TitelText"             'INHERIT_ONLY_ACE  
    Const AF04 = "AF&;&H10;TitelText"             'INHERIT_ACE"  

    'Zugriffs-Type  

    Const ATx0 = "AT=;&H00;TitelText"             'ACCESS_ALLOWED_ACE_TYPE  
    Const AT00 = "AT&;&H01;TitelText"             'ACCESS_DENIED_ACE_TYPE  
    Const AT01 = "AT&;&H02;TitelText"             'AUDIT  

   'Zugriffsrechte: Objektspezifisch  

    Const AM00 = "AM&;&H00000001;TitelText"       'DIR_LIST_DIRECTORY/FILE_READ_DATA  
    Const AM01 = "AM&;&H00000002;TitelText"       'DIR_ADD_FILE/FILE_WRITE_DATA  
    Const AM02 = "AM&;&H00000004;TitelText"       'DIR_ADD_SUBDIRECTORY/FILE_APPEND_DATA  
    Const AM03 = "AM&;&H00000008;TitelText"       'READ_NAMED_ATTRIBUTS  
    Const AM04 = "AM&;&H00000010;TitelText"       'WRITE_NAMED_ATTRIBUTS  
    Const AM05 = "AM&;&H00000020;TitelText"       'EXECUTE  
    Const AM06 = "AM&;&H00000040;TitelText"       'DELETE_CHILD  
    Const AM07 = "AM&;&H00000080;TitelText"       'READ_ATTRIBUTES  
    Const AM08 = "AM&;&H00000100;TitelText"       'WRITE_ATTRIBUTES  
    Const AMx1 = "AM=;&H001F01FF;TitelText"       'FILE_ALL_ACCESS"  

    'Zugriffsrechte: Standard --> Zugriffsrechte auf Objektspezifisch  

    Const AM16 = "AM&;&H00010000;TitelText"       'DELETE  
    Const AM17 = "AM&;&H00020000;TitelText"       'READ_ACL  
    Const AM18 = "AM&;&H00040000;TitelText"       'WRITE_ACL  
    Const AM19 = "AM&;&H00080000;TitelText"       'WRITE_OWNER  
    Const AM20 = "AM&;&H00100000;TitelText"       'SYNCHRONIZE  

    'Zugriffsrechte: Security-Descriptor SACL (System Access Control List)  
    Const AM24 = "AM&;&H01000000;TitelText"       'ACCESS_SYSTEM_SECURITY  

    'Zugriffsrechte Erweitert --> Zugriffsrechte auf Standard/Objektspezifisch  
    Const AM28 = "AM&;&H10000000;TitelText"       'GENERIC_ALL  
    Const AM29 = "AM&;&H20000000;TitelText"       'GENERIC_EXECUTE  
    Const AM30 = "AM&;&H40000000;TitelText"       'GENERIC_WRITE  
    Const AM31 = "AM&;&H80000000;TitelText"       'GENERIC_READ  

    Const Msg0 = "Der Vorgang kann je nach Anzahl der Ordner einige Minuten dauern!"  
    Const Msg1 = "Das Einlesen der Rechte aus %1 Ordnern ist abgeschlossen."  
    Const Msg2 = "Pfadname:"  
    Dim Fso As Object, ACL As Object, objWMIService As Object, TextLine As Variant, TitelLine As Variant

    Dim TextSize As Long, CellSize As Long, FoldersCount As Long, NewLine As Long, EndLine As Long

Public Sub KonstFoldersPath()

   FoldersPath = Workbooks("Verzeichnisrechte.xlsx").Worksheets("Einstellungen").Range("B3").Value  
   
End Sub

Sub GetFoldersAccessRights()

    Dim TextList As Variant, Token As Variant, i As Integer
    
    If MsgBox(Msg0, vbOKCancel Or vbInformation, "Zugriffsrechte...") = vbCancel Then Exit Sub  

    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)
    TextSize = UBound(TextList) + TextReserved:  CellSize = TextSize + 1
    ReDim TextLine(TextSize):  ReDim TitelLine(TextSize)

  Set ACL = CreateObject("Scripting.Dictionary")  

    TitelLine(0) = "Pfad"  
    TitelLine(1) = "Erstellt"  
    TitelLine(2) = "Benutzer"  
    TitelLine(3) = "SID"  

    For i = 0 To UBound(TextList)

        Token = Split(TextList(i), ";")  
        ACL.Add Token(0) & Hex(Token(1)), i + TextReserved & ";" & Token(1)  
        TitelLine(i + TextReserved) = Token(2)

    Next

    Set Fso = CreateObject("Scripting.FileSystemObject")  
    Set objWMIService = GetObject("winmgmts:{impersonationLevel=Impersonate,(TakeOwnership)}!\\.\root\cimv2")  

    FoldersCount = 0

    Call CleanUpSheets

    Range(Range("A1"), Cells(1, CellSize)) = TitelLine  
    Call GetFolder(Fso.GetFolder(FoldersPath))

    MsgBox Replace(Msg1, "%1", FoldersCount), vbInformation, "Rechte einlesen..."  

End Sub

Private Sub GetFolder(ByRef Folder)

    Dim Subfolder As Object, i As Integer
   TextLine(0) = Folder.Path

    If Folder.Name = "" Then  
        TextLine(1) = ""  
    Else
        TextLine(1) = FormatDateTime(Folder.DateCreated, vbShortDate)
    End If

    Call GetSecuritySettings(Folder)

    On Error Resume Next

    For Each Subfolder In Folder.SubFolders

        If Err.Number = 0 Then
            Call GetFolder(Subfolder)
        Else
            Err.Clear
            Call WriteText("Zugriff verweigert")  
        End If
    Next
End Sub

Private Sub GetSecuritySettings(ByRef Folder)
    Dim objFSS As Object, objSD As Object, objACL As Variant
    Dim LastName As String, DoWrite As Boolean, i As Integer

    FoldersCount = FoldersCount + 1

    On Error Resume Next

    Set objFSS = objWMIService.Get("Win32_LogicalFileSecuritySetting='" & Folder & "'")  

    If Err.Number <> 0 Then
        Call WriteText("Nicht verf?gbar"):  Exit Sub  
    End If

    On Error GoTo 0

    If objFSS.GetSecurityDescriptor(objSD) = 0 Then

        If (objSD.ControlFlags And SE_DACL_PRESENT) <> 0 Then
            For Each objACL In objSD.DACL
                With objACL
                    TextLine(2) = .Trustee.Name
                    TextLine(3) = .Trustee.SIDString

                    For i = 4 To TextSize:  TextLine(i) = "":  Next  

                    Call SetSecuritySettings("AM", .AccessMask)  
                    Call SetSecuritySettings("AF", .AceFlags)  
                    Call SetSecuritySettings("AT", .AceType)  

                    If NewLine > EndLine Then Call CreateNewSheet

                    Range(Cells(NewLine, 1), Cells(NewLine, CellSize)) = TextLine: NewLine = NewLine + 1
                End With
            Next
        Else
            Call WriteText("Nicht verf?gbar")  
        End If
    Else
        Call WriteText("Nicht verf?gbar")  
    End If
End Sub

Private Sub SetSecuritySettings(ByRef Target, ByVal Value)
    Dim Key As Variant, Token As Variant

    If ACL.Exists(Target & "=" & Hex(Value)) Then  
        Token = Split(ACL.Item(Target & "=" & Hex(Value)), ";")  
        TextLine(Token(0)) = "x"  
    Else
        For Each Key In ACL.Keys
            If Left(Key, 3) = Target & "&" Then  
                Token = Split(ACL.Item(Key), ";")  
                If (Value And CLng(Token(1))) Then TextLine(Token(0)) = "x"  
            End If
        Next
    End If
End Sub

Private Sub WriteText(ByRef Text)

    Dim i As Integer
    TextLine(2) = Text

    For i = 3 To TextSize:  TextLine(i) = "":  Next  

    If NewLine > EndLine Then Call CreateNewSheet

    Range(Cells(NewLine, 1), Cells(NewLine, CellSize)) = TextLine: NewLine = NewLine + 1
End Sub

Private Sub CleanUpSheets()
    Dim Wks As Worksheet

    ThisWorkbook.Activate

    Sheets(SheetName).Cells.Clear

    For Each Wks In Sheets
        If Wks.Name Like Left(SheetName, Len(SheetName) - 1) & "[!1]" Then  
            Application.DisplayAlerts = False
            Wks.Delete
            Application.DisplayAlerts = True
        End If
    Next

    Sheets(SheetName).Activate:  Range("A1").Select  
    NewLine = StartLine:  EndLine = Rows.Count

End Sub

Private Sub CreateNewSheet()
    Dim LastNumber As Integer, LastName As String

    LastName = ActiveSheet.Name
    LastNumber = Right(LastName, 1)

    Sheets.Add After:=ActiveSheet

    ActiveSheet.Name = Replace(LastName, LastNumber, LastNumber + 1)

    Range(Range("A1"), Cells(1, CellSize)) = TitelLine  

    NewLine = StartLine

End Sub

Vielleicht ist das eine Kleinigkeit...

Vielen Dank für die Hilfe.

Grüße V

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 586527

Url: https://administrator.de/contentid/586527

Ausgedruckt am: 24.11.2024 um 04:11 Uhr

9 Kommentare

Neuester Kommentar

Hallo Volker

eventuell liegt's daran, dass du den Text und nicht den Wert der Zelle B3 haben möchtest.
schau mal hier:
https://docs.microsoft.com/de-de/office/vba/api/excel.range.text

Gruß

Tsuki

Hi Tsuki,

das habe ich geändert, verursacht aber einen Fehler: Ungültiger Prozeduraufruf oder ungültiges Argument.

Public Sub KonstFoldersPath()

    Dim cell As Range
    Set cell = Workbooks("Verzeichnisrechte.xlsx").Worksheets("Einstellungen").Range("B3")  
    
    FoldersPath = cell.Text
    
End Sub

Ich kann begreife noch nicht, wie ich das in die Variable "FolderPath" aus diesem Public Sub KonstFoldersPath() transportiere und inSub GetFoldersAccessRights()rein bringen kann.

Wie bekommt die Anweisung Call GetFolder(Fso.GetFolder(FoldersPath)) den Inhalt der Variable FoldersPath aus der Public Sub?

Für Manche ist das Basiswissen, doch ich tu mich dabei schwer.

Danke für die Hilfe.

Grüße
V

Hi,

Ich kann begreife noch nicht, wie ich das in die Variable "FolderPath" aus diesem Public Sub KonstFoldersPath() transportiere und inSub GetFoldersAccessRights()rein bringen kann.

Wenn Du von "FoldersPath" reden solltest (beachte "s"):
Da musst Du nichts "transportieren", da die Variable auf Modulebene deklariert ist. Wenn Du diese nicht auf Sub- oder Function-Ebene neu deklarierst, dann benutzen alle Sub und Functions diese Modul-Variable.

E.

Hi,

also ist das, was in der Public Sub KonstFoldersPath() steht auch überall in der Variable FoldersPath enthalten?
...wie kann ich das in der Laufzeit prüfen, was in welcher Variable enthalten ist?

Woran kann ich sehen, an welcher Stelle das Programm abbricht?

Grüße
v

Über den Debugger mit Einzelschrittausführung.
Wenn Du links an einer Codezeile mit der Maus klickst, dann erstellt er einen Haltepunkt. D.h. die Ausführung hält an und Du kannst dann Zeile für Zeile abarbeiten lassen.

Wenn du in den Makro-Editor gehst, kannst du den Code "debuggen" oder bis zu einer bestimmten Stelle ausführen. Da kann man dann auch sehen, was zum Beispiel in einer Variable gerade für ein Wert/Text steht.
Wenn du das Programm von dort aus startest, sollte er an die Stelle des Fehlers springen.

Dann kann man weiter die Ursache eingrenzen.

Gruß

Tsuki

Hallo TsukiSan,

danke für die Hilfe. Jetzt sehe ich auch den Fehler. Warum liegt der Index hier außerhalb des Bereiches?:

Public Sub KonstFoldersPath()

    Dim cell As Range
    Set cell = Workbooks("Verzeichnisrechte.xlsx").Worksheets("Einstellungen").Range("B3")  
    
    FoldersPath = cell.Text
    
End Sub

Im Blatt "Einstellungen" steht der Pfad in B3. Ich bin ratlos. Weiter oben habe ich doch das richtig gemacht oder?:

    Public FoldersPath As String    'Start-Ordner

Vielleicht hast Du eine Idee.

Grüße
VB

Das kann sich auch die beiden anderen Collections beziehen
Workbooks("Verzeichnisrechte.xlsx")
Worksheets("Einstellungen")

Hi emeriks,

du hattest recht, es lag an der Bezeichnung. Erst als ich eine "1" hinter "Einstellungen" geschrieben hab, hat das Ganze funktioniert.

Recht herzlichen Dank.

Wenn ich jetzt eine neue Suche initiiere, wird mir der der Inhalt des zuvor verwendeten Ordners aufgelistet. Was ich meine ist, ich suchte im 1. Durchlauf den Ordner C:\A und möchte anschließend C:\B durchsuchen lassen, was er nicht tut. Er listet alles von C:\A auf und nicht von C:\B, obwohl in B3 im Worksheet "Einstellungen1" der Wert "C:\B" steht.

An welcher Stelle muss ich die Variable FoldersPath löschen? Ist "Sub GetFoldersAccessRights()" der richtige Platz?

Ich bin mir nicht sicher, ob ich eine 2. Frage mit anbringen darf...

Wie bringe ich dem Skript bei, über einen Button "optional" nur die erste Ebene und nicht die kompletten Unterordner einbeziehen lassen will?

Ich danke dir...

Grüße
V

Frage VB for Applications Entwicklung

Mehr von VolkerB

VBA: Gruppen eines Benutzers auslesen und darstellenVolkerB - 1 Kommentar

Excel VB: effektive AD-Gruppen Mitglieder auflistenVolkerB - 2 Kommentare

Daten vom alten RAID 1 auf ein Neues umziehenVolkerB - 24 Kommentare

Backup mit Zip-Dateien erstellenVolkerB - 7 Kommentare

Heiß diskutiert