Check Folder Permissions Before Save VBA

Question

I Have created a user form that will open an excel file open & hide the excel. When closing the user form will save & close the excel file. However, there are two types of users of the excel file.

1. Editors - Those who are entering data into the file
2. Viewers - Those who are viewing a file.

The folder which has the excel file only allow "Editors" to save. (Others have no permission to write). Therefore, I have to avoid save part if the user has no wright permission to the folder. Any ideas? My code for the close event of user form is here.

Private Sub UserForm_QueryClose (Cancel As Integer, CloseMode As Integer)

If CloseMode = vbFormControlMenu Then

If ws.AutoFilterMode Then ws.AutoFilterMode = False
ws.Columns("F:H").Copy
ws.Activate
ws.Range("F1").Select
Application.DisplayAlerts = False
Selection.PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.Visible = True
ActiveWorkbook.CheckCompatibility = False
ThisWorkbook.Close savechanges:=True
ActiveWorkbook.CheckCompatibility = True
End If
End Sub

Ws Denoted the declared name for the worksheet.

Edit

I have tried & found an alternative method to overcome the situation. However, this is not the solution & is a dirty method to get the result. Please see below code.

Private Sub UserForm_QueryClose (Cancel As Integer, CloseMode As Integer)
On Error Resume Next
If CloseMode = vbFormControlMenu Then
If ws.AutoFilterMode Then ws.AutoFilterMode = False
ws.Columns("F:H").Copy
ws.Activate
ws.Range("F1").Select
Application.DisplayAlerts = False
Selection.PasteSpecial Paste:=xlPasteValues
Application.DisplayAlerts = True
Application.CutCopyMode = False
Application.Visible = True
ActiveWorkbook.CheckCompatibility = False
ThisWorkbook.Save
ThisWorkbook.Close savechanges:=False
ActiveWorkbook.CheckCompatibility = True
End If

End Sub

On above code I have tracked error generated during the save process of viewers & jump to next line by using on error resume next .

Answer 1

The answer above from Macro Man , while succinct and useful, will not work in an environment where folder access is managed by user groups instead of user names. As many corporate environments - including my own - use this method to manage folder access, I have posted below a solution that will assess a user's actual permissions to a folder. This will work whether the user has been granted individual or group access to a folder.

Private Function TestWriteAccess(ByVal StrPath As String) As Boolean

Dim StrName As String, iFile As Integer, iCount As Integer, BExists As Boolean

'Set the initial output to False
TestWriteAccess = False

'Ensure the file path has a trailing slash
If Right(StrPath, 1) <> "\" Then StrPath = StrPath & "\"

'Ensure the path exists and is a folder
On Error Resume Next
BExists = (GetAttr(StrPath) And vbDirectory) = vbDirectory
If Not BExists Then GoTo Exit_TestWriteAccess 'Folder does not exist
'Set error handling - return False if we encounter an error (folder does not exist or file cannot be created)
On Error GoTo Exit_TestWriteAccess

'Get the first available file name
Do
    StrName = StrPath & "TestWriteAccess" & iCount & ".tmp"
    iCount = iCount + 1
Loop Until Dir(StrName) = vbNullString

'Attempt to create a test file
iFile = FreeFile()

Open StrName For Output As #iFile
Write #iFile, "Testing folder access"
Close #iFile

TestWriteAccess = True

'Delete our test file
Kill StrName

Exit_TestWriteAccess:
End Function

In researching file access, I also stumbled upon Check Access Rights to File/Directory on NTFS Volume by Segey Merzlikin on FreeVBcode.com; this solution is overkill for my needs (and OP's) but will return the exact access rights that a user has to a particular file.

Answer 2

This checks the access list of the workbook's folder to see if the user's name appears in the list. If it does, then save the file.

If Instr(1, Environ("USERNAME"), CreateObject("WScript.Shell").Exec("CMD /C ICACLS """ & _
ThisWorkbook.Path & """").StdOut.ReadAll) > 0 Then ThisWorkbook.Save

It does this by opening a command prompt, running the ICACLS command through it and reading the output from that command. Then it uses the InStr() method to see if the username appears in that output.