保存VBA之前檢查文件夾權限

Question

我已經創建了一個用戶窗體，該窗體將打開一個excel文件並打開並隱藏excel。 關閉用戶表單時，將保存並關閉Excel文件。 但是，excel文件有兩種類型的用戶。

1. 編輯器-將數據輸入文件的人員
2. 查看者-查看文件的人。

具有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表示工作表的聲明名稱。

編輯

我已經嘗試並找到了另一種方法來克服這種情況。 但是，這不是解決方案，並且是獲取結果的骯臟方法。 請參見下面的代碼。

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所檢查的NTFS卷上對文件/目錄的訪問權限 。 此解決方案對於我（和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（）方法查看用戶名是否出現在該輸出中。