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