檢查文件夾權限保存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

此檢查工作簿的文件夾的訪問列表，看看如果用戶的名稱出現在列表中。如果是，則保存該文件。

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答案，而簡潔實用，不會在文件夾訪問由用戶組而不是用戶名管理的環境中工作。由於許多公司環境（包括我自己的）使用此方法來管理文件夾訪問，我在下面發佈了一個解決方案，用於評估用戶對文件夾的實際權限。無論用戶是否已被授予個人或組訪問權限，這都會起作用。

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 

在研究文件的訪問，我也偶然發現Check Access Rights to File/Directory on NTFS Volume通過Segey Merzlikin上FreeVBcode.com;這個解決方案對我的需求（和OP的）是過度的，但會返回用戶對特定文件的確切訪問權限。