Как проверить, есть ли у пользователя доступ на запись в папку?

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

Я ожидаю, что это скажет. Имя доступно только для чтения !, но оно не работает для атрибутов .atatly и только для чтения. Он просто говорит, что этот файл не существует

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