'**********************************************************************************************************
' 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




'**********************************************************************************************************
' Name:                 uniqueFolderName
' Author:               mielk | 2012-12-02
'
' Comment:              Function transforms the given folder name so that it is unique in its
'                       parent folder.
'
' Parameters:
'   folderName          The name of the folder to be transformed.
'
' Returns:
'   String              The specified folder name transformed into a unique one.
'                       If the parent folder doesn't containt the folder with such name, the original name
'                       is returned.
'                       If the folder with the specified name already exists in the parental folder, the
'                       number in brackets is appended to the given folder name.
'
'                       Example:
'                       ---------------------------------------------------------------------------------
'                       If you run the function for the folder name C:\folders\test and its parental
'                       folder (C:\folders\) doesn't contain any folder with this name, the original
'                       name (C:\folders\test) is returned.
'
'                       However, if the parental folder already contains a folder with this name, the name
'                       C:\folders\ test (1) is returned.
'                       In case this transformed name also exists already, the next number is appended:
'                       C:\folders\test (2), and so on.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-12-02        mielk       Function created.
'**********************************************************************************************************
Public Function uniqueFolderName(folderName As String) As String
    Const METHOD_NAME As String = "uniqueFolderName"
    '------------------------------------------------------------------------------------------------------
    Static objFSO As Object                 '(Late binding that allows to use the function, even if
                                            'Microsoft Scripting Runtime library is not loaded)
    Dim strFolderName As String
    Dim strParentFolder As String
    Dim strTempName As String
    Dim intCounter As Integer
    '------------------------------------------------------------------------------------------------------



    'Create FileSystemObject instance if it hasn't been created yet. ------------------------------------|
    If objFSO Is Nothing Then                                                                           '|
        Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")                                     '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    With objFSO
        
        'Checks if the folder already exists. -----------------------------------------------------------|
        If .FolderExists(folderName) Then                                                               '|
                                                                                                        '|
            'If the given folder name already exists, function transforms its name by                   '|
            'appending the number in brackets.                                                          '|
            strParentFolder = .GetParentFolderName(folderName)                                          '|
            If Not VBA.right$(strParentFolder, 1) = "\" Then strParentFolder = strParentFolder & "\"    '|
            strFolderName = .GetBaseName(folderName)                                                    '|
                                                                                                        '|
            '------------------------------------------------------------------------------------|      '|
            Do                                                                                  '|      '|
                intCounter = intCounter + 1                                                     '|      '|
                strTempName = strParentFolder & strFolderName & " (" & intCounter & ")"         '|      '|
            Loop While .FolderExists(strTempName)                                               '|      '|
            '------------------------------------------------------------------------------------|      '|
                                                                                                        '|
            uniqueFolderName = strTempName                                                              '|
                                                                                                        '|
        Else                                                                                            '|
                                                                                                        '|
            'The given folder name is unique in the file system and is returned in its                  '|
            'original form.                                                                             '|
            uniqueFolderName = folderName                                                               '|
                                                                                                        '|
        End If                                                                                          '|
        '-------- [If .FolderExists(folderName) Then] ---------------------------------------------------|
        
    End With


End Function