Question

我创建了一个打开excel文件的用户表单＆amp;隐藏excel。关闭用户表单时将保存＆amp;关闭excel文件。但是，excel文件有两种类型的用户。

编辑 - 将数据输入文件的人
观看者 - 正在查看文件的人。

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

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

修改

我试过＆amp;找到了克服这种情况的另一种方法。然而，这不是解决方案＆amp;获取结果是一种肮脏的方法。请参阅下面的代码。

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

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

在研究文件访问时，我也在FreeVBcode.com上偶然发现了Segey Merzlikin的Check Access Rights to File/Directory on NTFS Volume;这个解决方案对我的需求（和OP）来说太过分了，但会返回用户对特定文件的确切访问权限。

Answer 2

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

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

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

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

2 个答案: