如何檢查用戶是否對文件夾具有寫權限？

Question

我正在嘗試檢查我所能獲得的所有權限，以便人們可以選擇任何文件，並且在程序稍后失敗之前，他們可以獲得一條錯誤消息，直接響應他們無法保存到該位置的原因。 我現在介紹的兩個工作是“未選擇文件夾”和“此文件不存在”。 說它是只讀的是行不通的，如果有人有任何有用的提示，將不勝感激，或者我可以對文件進行更多檢查的任何想法。 我正在使用計算機上的程序文件文件對其進行測試。

Sub CreateFile()

    Dim BaseDirectory As String
    Dim FS As FileSystemObject
    Set FS = New FileSystemObject

    BaseDirectory = GetFolder()

    If (BaseDirectory = vbNullString) Then
       MsgBox "No Folder Selected", vbExclamation, "Error"
       GoTo EndProgram
    End If

   'Not Working
    With FS.GetFolder(BaseDirectory)
        If (.Attributes And ReadOnly) Then
        MsgBox .Name & " is readonly!"
        GoTo EndProgram
        End If
    End With

    If Len(Dir(BaseDirectory)) = 0 Then
       MsgBox "This file does NOT exist."
       GoTo EndProgram
    End If

EndProgram:
End Sub

Function GetFolder() As String

    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
            sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

我期待這會說 .Name 是只讀的！，但它不適用於 .attributes 和 readonly。 它只是說這個文件不存在

Answer 1

這是一個檢查當前用戶是否對文件夾具有寫入權限的函數。 它的工作原理是在該文件夾中創建一個臨時文件用於寫入，如果它能夠創建它，那么它將返回 true。 否則，此函數將返回 false。

'CHECK TO SEE IF CURRENT USER HAS WRITE ACCESS TO FOLDER
Public Function HasWriteAccessToFolder(ByVal FolderPath As String) As Boolean

    '@example: HasWriteAccessToFolder("C:\Program Files") -> True || False

    'MAKE SURE FOLDER EXISTS, THIS FUNCTION RETURNS FALSE IF IT DOES NOT
    Dim Fso As Scripting.FileSystemObject
    Set Fso = New Scripting.FileSystemObject
    If Not Fso.FolderExists(FolderPath) Then
        Exit Function
    End If

    'GET UNIQUE TEMP FilePath, DON'T WANT TO OVERWRITE SOMETHING THAT ALREADY EXISTS
    Do
        Dim Count As Integer
        Dim FilePath As String

        FilePath = Fso.BuildPath(FolderPath, "TestWriteAccess" & Count & ".tmp")
        Count = Count + 1
    Loop Until Not Fso.FileExists(FilePath)

    'ATTEMPT TO CREATE THE TMP FILE, ERROR RETURNS FALSE
    On Error GoTo Catch
    Fso.CreateTextFile(FilePath).Write ("Test Folder Access")
    Kill FilePath

    'NO ERROR, ABLE TO WRITE TO FILE; RETURN TRUE!
    HasWriteAccessToFolder = True

Catch:

End Function

Answer 2

利用功能？ 我正在使用 VBS（不是 VBA），但有人可能仍然會發現這是一個有用的觀察。 如果在不存在或 perms 問題的路徑上運行 fso 命令，它將返回函數和錯誤代碼，使用它來確定用戶是否有權訪問該文件夾：

'VBS Example:

Function TestDirectory(FullDirPath)
'Purpose: test creation, if path doesn't exist or permissions issue, function will return error code
    strDir = fso.GetAbsolutePathName(FullDirPath)
    strDir = strDir & "\_randfoldercrtplsdelthis"
    fso.CreateFolder strDir
    If fso.FolderExists(strDir) Then
        fso.DeleteFolder strDir, TRUE
    End If
End Function

On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
Set Shell = CreateObject("WScript.Shell")

FilePath = "C:\Restricted Start Menu Locked\"
If TestDirectory(FilePath) <> 0 Then
    WScript.Echo "Folder Access Denied? Error = " & Err.Number
Else
    WScript.Echo "Woot!"
End If