在保存VBA之前检查文件夹权限

我创build了一个用户窗体，打开一个excel文件，打开并隐藏excel。 当closures用户表单将保存并closuresExcel文件。 但是，有两种types的Excel文件的用户。

1. 编辑者 – 正在将数据input到文件中的人员
2. 观众 – 正在查看文件的用户。

具有Excel文件的文件夹只允许“编辑”保存。 （其他人没有权限写）。 因此，如果用户对文件夹没有权限，我必须避免保存部分。 有任何想法吗？ 我的用户表单closures事件的代码在这里。

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表示工作表的声明名称。

编辑

我已经尝试过，find了一种可以克服这种情况的方法。 但是，这不是解决scheme，是一个肮脏的方法来获得结果。 请看下面的代码。

 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 error resume next使用跳转到下一行。

Answer 1

这将检查工作簿的文件夹的访问列表以查看用户的名称是否出现在列表中。 如果是，则保存该文件。

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

这是通过打开命令提示符，通过运行ICACLS命令并读取该命令的输出来完成的。 然后它使用InStr（）方法来查看用户名是否出现在输出中。

Answer 2

上面这个来自Macro Man的答案虽然简洁而有用，但在文件夹访问由用户组而不是用户名pipe理的环境中将不起作用。 由于许多企业环境（包括我自己的）使用这种方法来pipe理文件夹访问，我在下面发布了一个解决scheme，用于评估用户对文件夹的实际权限。 无论用户是否被授予对文件夹的个人或组访问权限，这都将起作用。

 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 

在研究文件访问方面，我也偶然发现FreeVBcode.com上的检查访问权限的文件/目录在NTFS卷由Segey Merzlikin; 这个解决scheme对于我的需要（和OP）是过度的，但是会返回用户对特定文件的确切访问权限。