Abstract

You work in a fairly complex environment? Where you need read and write access rights to dozens of folders? You need to request this access from your IT department and and then you want to check whether you already got the requested access?

Then this program will hopefully be of help. First you define all necessary read/write access rights, maybe even for different teams:

test_access_rights_folders

Then run this app:

test_access_rights_main

Now you can see which access you have got: test_access_rights_log

Appendix – Test_Access_Rights Code

Please note: this program needs (uses) the classes SystemState and Logging.

Please read my Disclaimer.

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

Please read my Disclaimer.

Test_Access_Rights.xlsm [63 KB Excel file, open and use at your own risk]