'**********************************************************************************************************
' Nazwa:                czyMoznaDodawacPodfoldery
' Autor:                mielk | 2012-12-02
'
' Opis:                 Funkcja sprawdzająca czy aktualny użytkownik ma uprawnienia, żeby dodawać
'                       podfoldery do danego folderu.
'
' Argumenty:
'   sciezkaDoFolderu    Ścieżka do folderu, który ma zostać sprawdzony.
'
' Zwraca:
'   Boolean             True - jeżeli do danego folderu można dodawać podfoldery.
'                       False - w innym przypadku.
'
' Wyjątki:
'   NieistniejacyFolder             Wywoływany jeżeli folder o podanej ścieżce nie istnieje.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2012-12-02        mielk           Utworzenie funkcji.
'**********************************************************************************************************
Public Function czyMoznaDodawacPodfoldery(sciezkaDoFolderu As String) As Boolean
    Const NAZWA_METODY As String = "czyMoznaDodawacPodfoldery"
    Const SUBFOLDER_NAME As String = "TestFolder"
    '------------------------------------------------------------------------------------------------------
    Static objFSO As Object                 'Późne wiązanie pozwala korzystać z funkcji nawet jeżeli
                                            'nie jest załadowana biblioteka Microsoft Scripting Runtime.
    Dim strTempFolder As String
    '------------------------------------------------------------------------------------------------------


    'Tworzy instancję klasy FileSystemObject, jeżeli nie została jeszcze stworzona. ---------------------|
    If objFSO Is Nothing Then                                                                           '|
        Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")                                     '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    'Sprawdź czy podany folder w ogóle istnieje. --------------------------------------------------------|
    If objFSO.FolderExists(sciezkaDoFolderu) Then                                                       '|
                                                                                                        '|
        'Stwórz pełną ścieżkę do folderu tymczasowego.                                                  '|
        strTempFolder = sciezkaDoFolderu                                                                '|
        If Not VBA.right$(sciezkaDoFolderu, 1) = "\" Then strTempFolder = strTempFolder & "\"           '|
        strTempFolder = unikatowaNazwaFolderu(strTempFolder & SUBFOLDER_NAME)                            '|
                                                                                                        '|
        'Spróbuj stworzyć folder tymczasowy. ----------------------------------------------------|      '|
        On Error Resume Next                                                                    '|      '|
        Call objFSO.utworzFolder(strTempFolder)                                                 '|      '|
        On Error GoTo 0                                                                         '|      '|
        '----------------------------------------------------------------------------------------|      '|
                                                                                                        '|
        'Sprawdza czy folder pomocniczny został utworzony. Jeżeli tak, oznacza to, że -----------|      '|
        'możliwe jest dodawanie podfolderów w folderze źródłowym. W takiej sytuacji             '|      '|
        'funkcja zwraca wartość True i usuwa folder tymczasowy.                                 '|      '|
        If objFSO.FolderExists(strTempFolder) Then                                              '|      '|
            czyMoznaDodawacPodfoldery = True                                                    '|      '|
            Call objFSO.usunFolder(strTempFolder)                                             '|      '|
        End If                                                                                  '|      '|
        '----------------------------------------------------------------------------------------|      '|
                                                                                                        '|
    Else                                                                                                '|
                                                                                                        '|
        GoTo NieistniejacyFolder                                                                        '|
                                                                                                        '|
    End If                                                                                              '|
    '-------- [If objFSO.FolderExists(sciezkaDoFolderu) Then] -------------------------------------------|




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


'----------------------------------------------------------------------------------------------------------
NieistniejacyFolder:
    'Obsługa błędów dla sytuacji, kiedy podany folder nie istnieje.

    GoTo ExitPoint


End Function




'**********************************************************************************************************
' Nazwa:                unikatowaNazwaFolderu
' Autor:                mielk | 2012-12-02
'
' Opis:                 Funkcja przekształca podaną nazwę folderu, tak aby była ona unikatowa w ramach
'                       folderu, do którego należy.
'
' Argumenty:
'   nazwaFolderu        Nazwa folderu, która ma być przetworzona przez funkcję.
'
' Zwraca:
'   String              Podana ścieżka folderu, przekształcona do takiej postaci aby jego nazwa była
'                       unikatowa w ramach folderu nadrzędnego.
'
'                       * Jeżeli folder o podanej ścieżce nie istnieje, zwracana jest oryginalna ścieżka
'                       folderu.
'
'                       * Jeżeli folder o podanej ścieżce istnieje, zwracana jest oryginalna ścieżka po
'                       uprzednim dodaniu do nazwy folderu liczby porządkowej w nawiasie.
'
'
'                       Przykład:
'                       ---------------------------------------------------------------------------------
'                       Jeżeli funkcja została wywołana dla folderu C:\test\ a w systemie plików nie ma
'                       jeszcze takiego folderu, zwracana jest ścieżka w oryginalnej postaci (C:\test\).
'                       Jeżeli jednak istnieje już folder o takiej nazwie, leżący w tym samym folderze
'                       nadrzędnym, zwrócona zostanie ścieżka C:\test (1). Jeżeli również taki folder
'                       już istnieje, zwrócona ścieżka będzie miała postać: C:\test (2), itd.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2012-12-02        mielk       Utworzenie funkcji.
'**********************************************************************************************************
Public Function unikatowaNazwaFolderu(nazwaFolderu As String) As String
    Const NAZWA_METODY As String = "unikatowaNazwaFolderu"
    '------------------------------------------------------------------------------------------------------
    Static objFSO As Object                 'Późne wiązanie pozwala korzystać z funkcji nawet jeżeli
                                            'nie jest załadowana biblioteka Microsoft Scripting Runtime.
    Dim strNazwaFolderu As String
    Dim strFolderNadrzedny As String
    Dim strTempNazwa As String
    Dim intLicznik As Integer
    '------------------------------------------------------------------------------------------------------



    'Tworzy instancję klasy FileSystemObject, jeżeli nie została jeszcze stworzona. ---------------------|
    If objFSO Is Nothing Then                                                                           '|
        Set objFSO = VBA.CreateObject("Scripting.FileSystemObject")                                     '|
    End If                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    With objFSO

        'Sprawdź czy podany folder w ogóle istnieje. ----------------------------------------------------|
        If .FolderExists(nazwaFolderu) Then                                                             '|
                                                                                                        '|
            'Jeżeli folder o podanej nazwie już istnieje, funkcja przekształca sprawdzaną nazwę w ten   '|
            'sposób, że po oryginalnej nazwie folderu dodaje kolejne liczby w nawiasie.                 '|
            strFolderNadrzedny = .GetParentFolderName(nazwaFolderu)                                     '|
            If Not VBA.right$(strFolderNadrzedny, 1) = "\" Then strFolderNadrzedny = _
                                                                            strFolderNadrzedny & "\"    '|
            strNazwaFolderu = .GetBaseName(nazwaFolderu)                                                '|
                                                                                                        '|
            '------------------------------------------------------------------------------------|      '|
            Do                                                                                  '|      '|
                intLicznik = intLicznik + 1                                                     '|      '|
                strTempNazwa = strFolderNadrzedny & strNazwaFolderu & " (" & intLicznik & ")"   '|      '|
            Loop While .FolderExists(strTempNazwa)                                              '|      '|
            '------------------------------------------------------------------------------------|      '|
                                                                                                        '|
            unikatowaNazwaFolderu = strTempNazwa                                                        '|
                                                                                                        '|
        Else                                                                                            '|
                                                                                                        '|
            'Jeżeli nie znaleziony został folder o takiej ścieżce, oznacza to, że jest unikatowa        '|
            'i może być zwrócona w oryginalnej formie.                                                  '|
            unikatowaNazwaFolderu = nazwaFolderu                                                        '|
                                                                                                        '|
        End If                                                                                          '|
        '-------- [If .FolderExists(nazwaFolderu) Then] ---------------------------------------------------|

    End With


End Function