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
'**********************************************************************************************************
' Nazwa: usunFolder
' Autor: mielk | 2014-08-16
'
' Opis: Funkcja usuwająca z systemu plików folder o określonej ścieżce.
'
' Argumenty:
' sciezka Ścieżka folderu, który ma zostać usunięty.
'
' Zwraca:
' Boolean True - jeżeli podany folder został usunięty lub w ogóle nie istniał.
' False - jeżeli usunięcie pliku było niemożliwe (np. korzysta z niego w tym momencie
' inny użytkownik).
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2014-08-16 mielk Utworzenie funkcji.
'**********************************************************************************************************
Public Function usunFolder(sciezkaDoFolderu As String) As Boolean
Const NAZWA_METODY As String = "usunFolder"
Const ERR_NUM_NIE_ZNALEZIONA_SCIEZKA As Long = 76
'------------------------------------------------------------------------------------------------------
Static objFSO As Object 'Późne wiązanie pozwala korzystać z funkcji nawet jeżeli
'nie jest załadowana biblioteka Microsoft Scripting Runtime.
Dim sciezka 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 '|
'----------------------------------------------------------------------------------------------------|
'Jeżeli podana ścieżka jest zakończona slashem, zostaje on usunięty.
sciezka = VBA.IIf(VBA.right$(sciezkaDoFolderu, 1) = "\", _
utnijTekst(sciezkaDoFolderu, 1), sciezkaDoFolderu)
'Spróbuj usunąć podany plik. Jeżeli jest to niemożliwe, kod przeskakuje do labelu -------------------|
'NiemozliweUsunieciePliku. '|
On Error GoTo NiemozliweUsunieciePliku '|
Call objFSO.usunFolder(sciezka) '|
usunFolder = True '|
'----------------------------------------------------------------------------------------------------|
'==========================================================================================================
ExitPoint:
Exit Function
'----------------------------------------------------------------------------------------------------------
NiemozliweUsunieciePliku:
If VBA.Err.number = ERR_NUM_NIE_ZNALEZIONA_SCIEZKA Then
'Folder nie może zostać usunięty, ponieważ nie istnieje. W takiej sytuacji funkcja powinna
'zwrócić wartość True.
usunFolder = True
Else
'Folder nie może być usunięty z jakiegokolwiek innego powodu.
usunFolder = False
End If
End Function