Abstract

Sie arbeiten in einer relativ komplexen Umgebung? In der Sie Lese- und Schreibrechte auf Dutzende von Verzeichnissen benötigen? Sie müssen diese Zugriffe bei Ihrer EDV Abteilung bestellen und dann wiederholt prüfen, ob diese Rechte zugewiesen wurden?

Dann kann dieses Program Ihnen helfen. Zuerst spezifizieren Sie alle notwendigen Zugriffsrechte, ggf. für mehrere Teams:

test_access_rights_folders

Dann lassen Sie dieses Programm laufen:

test_access_rights_main

Nun können Sie sehen, welche Zugriffsrechte Sie haben: test_access_rights_log

Appendix – Programmcode Test_Access_Rights

Hinweis: Dieses Programm benötigt (verwendet) die Klassen SystemState und Logging.

Bitte den Haftungsausschluss im Impressum beachten.

Option Explicit

Public Const AppVersion As String = "Test_Access_Rights_Version_22" 'Each log will show which version it has been created with

Sub TestFolders()
'Test folder access.
'Source (EN): http://www.sulprobil.de/test_access_rights_en/
'Source (DE): http://www.berndplumhoff.de/test_access_rights_de/
'(C) (P) by Bernd Plumhoff  11-Jan-2023 PB V22
        
Dim bRead As Boolean, bWrite As Boolean
Dim FileNumber As Integer
Dim i As Long, j As Long
Dim s As String, sTry As String
Dim state As SystemState
Dim oUnit As Object
Dim v As Variant

Set state = New SystemState
If GLogger Is Nothing Then Call auto_open
GLogger.SubName = "TestFolders"
GLogger.info "Testing access to folders now"
Main.Calculate
Set oUnit = CreateObject("Scripting.Dictionary")
For Each v In Range("Units_Selected")
    s = Main.Range(v.Address).Offset(0, 1).Text
    oUnit(CStr(v)) = s
    If s = "x" Then GLogger.info "Unit " & v & " has value 'x'"
Next v
On Error GoTo ErrHdl
i = 2
s = wsF.Cells(i, 1)
Do While s <> ""
    Application.StatusBar = "Testing " & s
    bRead = False: bWrite = False
    If oUnit("ALL") = "x" Then
        bRead = True
        bWrite = True
    Else
        j = 2
        Do While wsF.Cells(1, j) <> "End"
            If oUnit(wsF.Cells(1, j).Text) = "x" Then
                If wsF.Cells(i, j) = "x" Then
                    If wsF.Cells(i, j + 1) = "x" Then bRead = True
                    If wsF.Cells(i, j + 2) = "x" Then bWrite = True
                End If
            End If
            j = j + 3
        Loop
    End If
    If bRead Then
        'Folder readable? Let us check this by ChDir into it
        sTry = "read"
        ChDir (s)
        GLogger.info "Can access (" & sTry & ") folder '" & s & "'"
    End If
    If bWrite Then
        'Folder writeable? Try to create Remove_me.txt here
        sTry = "write"
        FileNumber = FreeFile
        Open s & "\Remove_me.txt" For Output As #FileNumber
        Write #FileNumber, "This is just a write test. This file should" & _
            "get deleted again automatically. If it does not," & _
            " please do it manually. Thank you."
        Close #FileNumber
        Kill s & "\Remove_me.txt"
        GLogger.info "Can access (" & sTry & ") folder '" & s & "'"
    End If
LabelNext:
    i = i + 1
    s = wsF.Cells(i, 1)
Loop

GLogger.info "Testing access to folders finished"
Exit Sub
    
ErrHdl:
Select Case Err.Number
Case 52
    'Dir(s, vbDirectory) went wrong
    GLogger.fatal "Cannot access (" & sTry & ") folder '" & s & "'" & _
        IIf(sTry = "read" And bWrite, " - write access expected", "")
    Resume LabelNext 'Back to next row
Case 76
    'ChDir (s) was not possible
    GLogger.fatal "Cannot access (" & sTry & ") folder '" & s & "'" & _
        IIf(sTry = "read" And bWrite, " - write access expected", "")
    Resume LabelNext 'Back to next row
Case Else
    GLogger.fatal "Cannot access (" & sTry & ") folder '" & s & _
        "'. Error number: " & Err.Number & _
        IIf(sTry = "read" And bWrite, " - write access expected", "")
    Resume LabelNext 'Back to next row
End Select
        
End Sub

Function Env(Value As Variant) As String
    Env = Environ(Value)
End Function

Download

Bitte den Haftungsausschluss im Impressum beachten.

Test_Access_Rights.xlsm [63 KB Excel Datei, ohne jegliche Gewährleistung]