Stwórz folder


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
'**********************************************************************************************************
' Nazwa:                utworzFolder
' Autor:                mielk | 2012-12-02
'
' Opis:                 Funkcja sprawdza czy podany folder istnieje. Jeżeli tak, zwracane jest odniesienie
'                       do tego folderu.
'                       Jeżeli nie, folder jest tworzony i również zwracane jest odniesienie do niego.
'
' Argumenty:
'   sciezkaDoFolderu    Ścieżka folderu, do którego odniesienie ma być zwrócone.
'
' Zwraca:
'   Object              Obiekt typu Scripting.Folder reprezentujący podaną ścieżkę.
'
'                       Jeżeli folder już istnieje, funkcja zwraca referencję do tego folderu nie
'                       podejmując żadnych dodatkowych akcji.
'
'                       Jeżeli folder nie istnieje, funkcja tworzy go i zwraca odniesienie do tego folderu.
'
'                       Jeżeli folder nie istnieje i nie może być utworzony (np. z powodu braku uprawnień
'                       lub niepoprawnej ścieżki) zwracane jest Nothing.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2012-12-02        mielk           Utworzenie funkcji.
'**********************************************************************************************************
Public Function utworzFolder(sciezkaDoFolderu As String) As Object
    Const NAZWA_METODY As String = "utworzFolder"
    '------------------------------------------------------------------------------------------------------
    Static objFSO As Object         'Późne wiązanie pozwala korzystać z funkcji nawet jeżeli
                                    'nie jest załadowana biblioteka Microsoft Scripting Runtime.
    Dim strNazwaDysku As String
    Dim strFolderNadrzedny 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                                                                                              '|
    '----------------------------------------------------------------------------------------------------|


    With objFSO

        'Jeżeli podany folder już istnieje, jest przypisywany do zmiennej [utworzFolder] i zwracany -----|
        'jako wynik funkcji.                                                                            '|
        If .FolderExists(sciezkaDoFolderu) Then                                                         '|
                                                                                                        '|
            Set utworzFolder = .getFolder(sciezkaDoFolderu)                                             '|
                                                                                                        '|
        Else                                                                                            '|
                                                                                                        '|
            'Sprawdź czy istnieje nazwa dysku podana w ścieżce źródłowej. ---------------------------|  '|
            strNazwaDysku = .GetDriveName(sciezkaDoFolderu)                                         '|  '|
            If .DriveExists(strNazwaDysku) Then                                                     '|  '|
                                                                                                    '|  '|
                'Uzyskaj nazwę folderu nadrzędnego. ---------------------------------------------|  '|  '|
                strFolderNadrzedny = .GetParentFolderName(sciezkaDoFolderu)                     '|  '|  '|
                If Not .FolderExists(strFolderNadrzedny) Then                                   '|  '|  '|
                    'Jeżeli folder nadrzędny nie istnieje, funkcji [utworzFolder] jest          '|  '|  '|
                    'wywoływana rekurencyjnie i tworzy ten folder.                              '|  '|  '|
                    Call utworzFolder(strFolderNadrzedny)                                       '|  '|  '|
                End If                                                                          '|  '|  '|
                '--------------------------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
                '--------------------------------------------------------------------------------|  '|  '|
                On Error Resume Next                                                            '|  '|  '|
                Call .utworzFolder(sciezkaDoFolderu)                                            '|  '|  '|
                Set utworzFolder = .getFolder(sciezkaDoFolderu)                                 '|  '|  '|
                On Error GoTo 0                                                                 '|  '|  '|
                '--------------------------------------------------------------------------------|  '|  '|
                                                                                                    '|  '|
            End If                                                                                  '|  '|
            '-------- [If .DriveExists(strNazwaDysku) Then] -----------------------------------------|  '|
                                                                                                        '|
        End If                                                                                          '|
        '------------ [If .FolderExists(sciezkaDoFolderu) Then] -----------------------------------------|


    End With


End Function