保存 VBA 前检查文件夹权限
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/27287485/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Check Folder Permissions Before Save VBA
提问by Keashan
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.
我创建了一个用户表单，它将打开一个 excel 文件，打开并隐藏 excel。关闭用户表单时将保存并关闭 Excel 文件。但是，excel文件有两种类型的用户。
- Editors - Those who are entering data into the file
- 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.
包含 excel 文件的文件夹只允许“编辑器”保存。（其他人无权写入）。因此，如果用户对文件夹没有 wright 权限，我必须避免保存部分。有任何想法吗？我的用户表单关闭事件代码在这里。
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.
Ws 表示工作表的声明名称。
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.
在上面的代码中，我跟踪了在查看器保存过程中生成的错误并使用
on error resume next.
回答by Nick Peranzi
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.
上面来自Macro Man的答案虽然简洁且有用，但在文件夹访问由用户组而不是用户名管理的环境中不起作用。由于许多公司环境（包括我自己的环境）使用此方法来管理文件夹访问权限，因此我在下面发布了一个解决方案，该解决方案将评估用户对文件夹的实际权限。无论用户已被授予对文件夹的个人或组访问权限，这都将起作用。
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 Volumeby 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.
在研究文件访问时，我还偶然发现了 Segey Merzlikin 在 FreeVBcode.com上的检查 NTFS 卷上文件/目录的访问权限；这个解决方案对于我的需求（和 OP）来说太过分了，但会返回用户对特定文件的确切访问权限。
回答by Sam
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.
它通过打开命令提示符，通过它运行 ICACLS 命令并读取该命令的输出来完成此操作。然后它使用 InStr() 方法查看用户名是否出现在该输出中。
