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