'**********************************************************************************************************
' Name:                 isTextfileWriteable
' Author:               mielk | 2012-12-02
'
' Comment:              Function to check if it is possible to write data into the specified textfile.
'
' Parameters:
'   filepath            The path of a file to be checked.
'
' Returns:
'   Boolean             True - if it is possible to write to a textfile with the given path.
'                       False - if the folder of the specified textfile doesn't exist or the user has
'                               not read-write access to it.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-12-02        mielk           Function created.
'**********************************************************************************************************
Public Function isTextfileWriteable(filepath As String) As Boolean
    Const METHOD_NAME As String = "isTextfileWriteable"
    'Define extensions of text files.
    Dim TEXT_EXTENSIONS As Variant:         TEXT_EXTENSIONS = Array("txt", "csv")
    '------------------------------------------------------------------------------------------------------
    Static objFSO As Object                 '(Late binding that allows to use the function, even if
                                            'Microsoft Scripting Runtime library is not loaded)
    Dim strDriveName As String
    Dim strBaseFolder As String
    Dim strParentFolder As String
    Dim strExtension 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                                                                                              '|
    '----------------------------------------------------------------------------------------------------|



    With objFSO

        'Check if the given textfile exists and if it is read-only. -------------------------------------|
        If .fileExists(filepath) Then                                                                   '|
                                                                                                        '|
            isTextfileWriteable = Not (VBA.GetAttr(filepath) And VBA.vbReadOnly)                        '|
                                                                                                        '|
        Else                                                                                            '|
                                                                                                        '|
            'Check if the drive from the given filepath exists. -------------------------------------|  '|
            strDriveName = .GetDriveName(filepath)                                                  '|  '|
            If .DriveExists(strDriveName) Then                                                      '|  '|
                                                                                                    '|  '|
                'Checks if the extension in the specified filepath is proper for a textfile. ----|  '|  '|
                strExtension = .GetExtensionName(filepath)                                      '|  '|  '|
                If isInArray(strExtension, TEXT_EXTENSIONS, False) Then                         '|  '|  '|
                                                                                                '|  '|  '|
                    'Retrieve the base folder name and check if it is allowed to add --------|  '|  '|  '|
                    'subfolders to this folder.                                             '|  '|  '|  '|
                    strParentFolder = .GetParentFolderName(filepath)                        '|  '|  '|  '|
                    strBaseFolder = .GetParentFolderName(filepath)                          '|  '|  '|  '|
                    Do Until .FolderExists(strBaseFolder)                                   '|  '|  '|  '|
                        strBaseFolder = .GetParentFolderName(strBaseFolder)                 '|  '|  '|  '|
                    Loop                                                                    '|  '|  '|  '|
                    '------------------------------------------------------------------------|  '|  '|  '|
                                                                                                '|  '|  '|
                                                                                                '|  '|  '|
                    '------------------------------------------------------------------------|  '|  '|  '|
                    If VBA.StrComp(strBaseFolder, strParentFolder, vbTextCompare) = 0 Then  '|  '|  '|  '|
                        'Destination folder already exists.                                 '|  '|  '|  '|
                        isTextfileWriteable = isFolderWriteable(strParentFolder)            '|  '|  '|  '|
                    Else                                                                    '|  '|  '|  '|
                        'Destination folder is yet to be created.                           '|  '|  '|  '|
                        isTextfileWriteable = isSubfoldersAddingAllowed(strBaseFolder)      '|  '|  '|  '|
                    End If                                                                  '|  '|  '|  '|
                    '------------------------------------------------------------------------|  '|  '|  '|
                                                                                                '|  '|  '|
                                                                                                '|  '|  '|
                Else                                                                            '|  '|  '|
                                                                                                '|  '|  '|
                    'The extension in the specified filepath is improper.                       '|  '|  '|
                    isTextfileWriteable = False                                                 '|  '|  '|
                                                                                                '|  '|  '|
                End If                                                                          '|  '|  '|
                '---- [If .FileExists(filepath) Then] -------------------------------------------|  '|  '|
                                                                                                    '|  '|
            Else                                                                                    '|  '|
                                                                                                    '|  '|
                'Drive retrieved from the given filepath doesn't exist.                             '|  '|
                isTextfileWriteable = False                                                         '|  '|
                                                                                                    '|  '|
            End If                                                                                  '|  '|
            '-------- [If .FileExists(filepath) Then] -----------------------------------------------|  '|
                                                                                                        '|
        End If                                                                                          '|
        '------------ [If .FileExists(filepath) Then] ---------------------------------------------------|

    End With


End Function











'**********************************************************************************************************
' Name:                 isInArray
' Author:               mielk | 2011-07-19
'
' Comment:              Checks if a specified value is contained in the given array.
'
' Parameters:
'   value               String to be checked.
'   arr                 Array to be tested.
'                       Each item of this array is compared to source value [value] and if any of them is
'                       equal to this string, function returns True.
'                       Parameter [arr] has to be a one-dimensional array that contains only values of
'                       primitive types. If it contain any object, exception ObjectsInArrayException will
'                       be thrown.
'   isCaseSensitive     Optional parameter of Boolean type.
'                       It determines if text comparing is case sensitive.
'                       If this value is set to True, comparing is case sensitive - a letter in lowercase
'                       is treated as different than the same letter in uppercase (i.e. a ? A).
'                       If this value is set to False, it doesn't matter if a letter is in lowercase or in
'                       uppercase, since both of them are considered as the same character (i.e. a = A).
'                       Default value of this parameter is False.
'
' Returns:
'   Boolean             True - if any item of the given array [arr] is equal to the
'                               specified string [str].
'                       False - otherwise.
'
' Exceptions:
'   NotArrayException               Thrown when the given [arr] parameter is not an array.
'   ObjectsInArrayException         Thrown when the given array contains not only values of primitive
'                                   types, but also objects.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2011-07-19    mielk       Class created.
'**********************************************************************************************************
Public Function isInArray(value As String, arr As Variant, _
                                                    Optional isCaseSensitive As Boolean = False) As Boolean
    Const METHOD_NAME As String = "startsWith"
    Dim SEPARATOR As String: SEPARATOR = VBA.Chr(0)
    '------------------------------------------------------------------------------------------------------
    Dim tempStr As String
    Dim uCompareMethod As VBA.VbCompareMethod
    '------------------------------------------------------------------------------------------------------

    
    'Checks if the given parameter [arr] is an array. If not, code moves to the -------------------------|
    'NotArrayException label.                                                                           '|
    If countDimensions(arr) <> 1 Then GoTo NotArrayException                                            '|
    '----------------------------------------------------------------------------------------------------|


    'Convert [isCaseSensitive] parameter of Boolean type to the [VbCompareMethod] enumeration. ----------|
    If isCaseSensitive Then                                                                             '|
        uCompareMethod = VBA.vbBinaryCompare                                                            '|
    Else                                                                                                '|
        uCompareMethod = VBA.vbTextCompare                                                              '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    'Try to convert the given array into String using VBA-built-in function Join. If there is -----------|
    'any object in the given array error will be generated and macro moves to the                       '|
    'ObjectsInArrayException label.                                                                     '|
    On Error GoTo ObjectsInArrayException                                                               '|
    tempStr = SEPARATOR & VBA.Join(arr, SEPARATOR) & SEPARATOR                                          '|
    On Error GoTo 0                                                                                     '|
    '----------------------------------------------------------------------------------------------------|


    isInArray = VBA.InStr(1, tempStr, SEPARATOR & value & SEPARATOR, uCompareMethod)


'==========================================================================================================
ExitPoint:
    Exit Function


'-----------------------------------------------
NotArrayException:
    '(...)
    'Put your own error handling here for a case if the given parameter [arr] is not array.
    
    GoTo ExitPoint


ObjectsInArrayException:
    '(...)
    'Put your own error handling here for a case if the given array contains any object.
    
    GoTo ExitPoint


End Function




'**********************************************************************************************************
' Name:         countDimensions
' Author:       mielk | 2012-03-03
'
' Comment:      Returns the number of dimensions of the given VBA array.
'
' Parameters:
'   arr         Array for which number of dimensions is to be returned.
'
' Returns:
'   Integer     The number of dimensions of the given VBA array.
'               If the given value is not an array function returns -1.
'               If the given value is declared as a dynamic array but its dimensions have not been
'               declared yet, 0 is returned.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-03-03        mielk       Function created.
' 2014-06-15        mielk       Returned type changed to Integer to allow -1 to be returned.
'                               For non-arrays values -1 is returned.
'**********************************************************************************************************
Public Function countDimensions(arr As Variant) As Integer
    Const METHOD_NAME As String = "countDimensions"
    '------------------------------------------------------------------------------------------------------
    Dim bound As Long
    '------------------------------------------------------------------------------------------------------


    If VBA.IsArray(arr) Then
        
        On Error GoTo NoMoreDimensions
        Do
            bound = UBound(arr, countDimensions + 1)
            countDimensions = countDimensions + 1
        Loop
        
    Else
        
        countDimensions = -1
        
    End If



'----------------------------------------------------------------------------------------------------------
NoMoreDimensions:

End Function




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






'**********************************************************************************************************
' Name:                 uniqueFilePath
' Author:               mielk | 2012-12-02
'
' Comment:              Function transforms the given filepath so that it is unique in the file system.
'
' Parameters:
'   filepath            The filepath to be transformed.
'
' Returns:
'   String              The specified filepath transformed into a unique one.
'                       If the specified filepath doesn't exist yet, the original name is returned.
'                       If the file with the specified path already exist, the path returned by the
'                       function consists of the original filepath and the number in brackets appended
'                       after the filename.
'
'                       Example:
'                       ---------------------------------------------------------------------------------
'                       If you run this function for filepath C:\test.txt and such file doesn't exist
'                       yet, the original filepath (C:\test.txt) is returned.
'
'                       However, if such file already exists, the filepath C:\test (1).txt is returned.
'                       In case this transformed filepath also exists already, the next number is appended:
'                       C:\test (2).txt and so on.
'
'
'                       Please note that the function doesn't check if the given filepath has been
'                       constructed properly. If the function is invoked with the improper filepath, it is
'                       just trying to find this file in the file system, but won't find it, since the
'                       filepath is improper, and will think about it as if it was a unique filepath.
'
'
' --- Changes log -----------------------------------------------------------------------------------------
' 2012-12-02            mielk       Function created.
'**********************************************************************************************************
Public Function uniqueFilePath(filepath As String) As String
    Const METHOD_NAME As String = "uniqueFilePath"
    '------------------------------------------------------------------------------------------------------
    Static objFSO As Object                 '(Late binding that allows to use the function, even if
                                            'Microsoft Scripting Runtime library is not loaded)
    Dim strFileExtension As String
    Dim strFileName As String
    Dim strParentFolder As String
    Dim strTempFilePath 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 file already exists. -------------------------------------------------------------|
        If .fileExists(filepath) Then                                                                   '|
                                                                                                        '|
            'If the given filepath already exists, function transforms its name by                      '|
            'appending the number in brackets.                                                          '|
            strParentFolder = .GetParentFolderName(filepath)                                            '|
            If Not VBA.right$(strParentFolder, 1) = "\" Then strParentFolder = strParentFolder & "\"    '|
            strFileName = .GetBaseName(filepath)                                                        '|
            strFileExtension = "." & .GetExtensionName(filepath)                                        '|
                                                                                                        '|
            '------------------------------------------------------------------------------------|      '|
            Do                                                                                  '|      '|
                intCounter = intCounter + 1                                                     '|      '|
                strTempFilePath = strParentFolder & strFileName & _
                                                " (" & intCounter & ")" & strFileExtension      '|      '|
            Loop While .fileExists(strTempFilePath)                                             '|      '|
            '------------------------------------------------------------------------------------|      '|
                                                                                                        '|
            uniqueFilePath = strTempFilePath                                                            '|
                                                                                                        '|
        Else                                                                                            '|
                                                                                                        '|
            'Specified filepath is unique in the file system and is returned in its original form.      '|
            uniqueFilePath = filepath                                                                   '|
                                                                                                        '|
        End If                                                                                          '|
        '-------- [If .FileExists(filepath) Then] -------------------------------------------------------|
        
    End With


End Function








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