Funkcja czyMoznaDodawacPodfoldery korzysta podczas działania z innych nie-wbudowanych funkcji prezentowanych na tej stronie, które w związku z tym również muszą być umieszczone w kodzie projektu dla prawidłowego działania tej funkcji.
Nie uwzględnienie ich w kodzie spowoduje wygenerowanie błędu: Compile error: Sub or Function not defined.
Dodatkowe funkcje wykorzystywane w funkcji czyMoznaDodawacPodfoldery zostały wymienione poniżej. Klikając w nazwę każdej z nich przeniesiesz się do podstrony zawierającej jej kod:
Dodając powyższe funkcje, zwróć uwagę czy nie były one już wcześniej wykorzystywane w Twoim kodzie. Obecność w jednym projekcie VBA dwóch funkcji publicznych o identycznych nazwach spowoduje wygenerowanie błędu kompilacji o treści: Compile error: Ambiguous name detected: nazwa_funkcji.
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: 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