How to check if user has write access to a folder? - excel

Question

I am trying to check all of the permissions that I can so that people can choose any file and before it fails later on in the program they can get an error message that directly responds to why they cannot save to that location. The two that work right now that I have covered are "No Folder Selected," and "This File does NOT exist". Saying that it is readonly is not working and if anyone has any helpful tips that would be greatly appreciated or any ideas of more checks that I could do about the files. I am testing it using the program files file on my computer.
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
I'm expecting this to say .Name is readonly!, but it does not work at .attributes and readonly. It just says This file does NOT exist

Answer 1

Here is a function that checks if the current user has write access to a folder. It works by creating a temp file in that folder for writing, if it's able to create it then it will return true. Otherwise, this function will return 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

Leverage the function? I'm using VBS (not VBA) but someone may still find this a useful observation. If you run the fso commands on a path that doesn't exist or perms issue it will return the function and error code, use that to determine if the user has access to that folder:
'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