Since function isFolderWriteable
uses some non-built VBA functions, they also must be included in your code for the function to work properly.
Otherwise the following error will occur: Compile error: Sub or Function not defined.
Required functions are listed below. You can get to each function's source code by clicking its name:
When adding the functions above to your VBA project, make sure you haven't done it before. If there are two different public functions with the same name in a single VBA project, the following compilation error is thrown: Compile error: Ambiguous name detected: function_name.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
'**********************************************************************************************************
' Name: isFolderWriteable
' Author: mielk | 2012-12-02
'
' Comment: Function to check if the current user has the rights to add, delete and modify
' files in the specified folder
'
' Parameters:
' folderPath The path of a folder to be checked.
'
' Returns:
' Boolean True - if the given folder exists and the current user has the read-write
' access to this folder.
' False - if the given folder doesn't exist or the user has not read-write
' access to it.
'
' Exceptions:
' FolderNotExistException Thrown if a folder with the specified path doesn't exist.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-12-02 mielk Function created.
'**********************************************************************************************************
Public Function isFolderWriteable(folderPath As String) As Boolean
Const METHOD_NAME As String = "isFolderWriteable"
Const TEMP_FILE_NAME As String = "TestFile.txt"
'------------------------------------------------------------------------------------------------------
Static objFSO As Object '(Late binding that allows to use the function, even if
'Microsoft Scripting Runtime library is not loaded)
Dim strTempFile As String
'------------------------------------------------------------------------------------------------------
'Create FileSystemObject instance if it hasn't been created yet. ------------------------------------|
If objFSO Is Nothing Then '|
Set objFSO = VBA.CreateObject("Scripting.FileSystemObject") '|
End If '|
'----------------------------------------------------------------------------------------------------|
'Check if the given folder exists at all. -----------------------------------------------------------|
If objFSO.FolderExists(folderPath) Then '|
'|
'Create the full path of a temporary file. '|
strTempFile = folderPath '|
If Not VBA.right$(folderPath, 1) = "\" Then strTempFile = strTempFile & "\" '|
strTempFile = uniqueFilePath(strTempFile & TEMP_FILE_NAME) '|
'|
'|
'Try to create a temporary file. --------------------------------------------------------| '|
On Error Resume Next '| '|
Call objFSO.CreateTextFile(strTempFile) '| '|
On Error GoTo 0 '| '|
'----------------------------------------------------------------------------------------| '|
'|
'|
'Check if temporary file has been created. If it exists, the function should ------------| '|
'return True and delete this file. '| '|
If objFSO.fileExists(strTempFile) Then '| '|
isFolderWriteable = True '| '|
Call objFSO.deleteFile(strTempFile) '| '|
End If '| '|
'----------------------------------------------------------------------------------------| '|
'|
Else '|
'|
GoTo FolderNotExistException '|
'|
End If '|
'-------- [If objFSO.FolderExists(folderPath) Then] -------------------------------------------------|
'==========================================================================================================
ExitPoint:
Exit Function
'----------------------------------------------------------------------------------------------------------
FolderNotExistException:
'(...)
'Put your own error handling here for a case if the given folder does not exist.
GoTo ExitPoint
End Function