Since function isSubfoldersAddingAllowed
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
'**********************************************************************************************************
' Name: isSubfoldersAddingAllowed
' Author: mielk | 2012-12-02
'
' Comment: Function to check if the current user has the rights to add subfolders to 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 rights to add
' subfolder to this folder.
' False - otherwise.
'
' Exceptions:
' FolderNotExistException Thrown if a folder with the specified path doesn't exist.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-12-02 mielk Function created.
'**********************************************************************************************************
Public Function isSubfoldersAddingAllowed(folderPath As String) As Boolean
Const METHOD_NAME As String = "isSubfoldersAddingAllowed"
Const SUBFOLDER_NAME As String = "TestFolder"
'------------------------------------------------------------------------------------------------------
Static objFSO As Object '(Late binding that allows to use the function, even if
'Microsoft Scripting Runtime library is not loaded)
Dim strTempFolder 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 folder. '|
strTempFolder = folderPath '|
If Not VBA.right$(folderPath, 1) = "\" Then strTempFolder = strTempFolder & "\" '|
strTempFolder = uniqueFolderName(strTempFolder & SUBFOLDER_NAME) '|
'|
'Try to create a temporary folder. ------------------------------------------------------| '|
On Error Resume Next '| '|
Call objFSO.createFolder(strTempFolder) '| '|
On Error GoTo 0 '| '|
'----------------------------------------------------------------------------------------| '|
'|
'Check if temporary folder has been created. If it exists, the function should ----------| '|
'return True and delete this folder. '| '|
If objFSO.FolderExists(strTempFolder) Then '| '|
isSubfoldersAddingAllowed = True '| '|
Call objFSO.deleteFolder(strTempFolder) '| '|
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