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
85
86
87
'**********************************************************************************************************
' 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