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
88
89
90
91
92
93
94
95
96
97
'**********************************************************************************************************
' Nazwa: unikatowaSciezka
' Autor: mielk | 2012-12-02
'
' Opis: Funkcja przekształca podaną ścieżkę do pliku, tak aby była ona unikatowa.
'
' Argumenty:
' sciezka Ścieżka do pliku, która ma być przetworzona przez funkcję.
'
' Zwraca:
' String Podana ścieżka, przekształcona do postaci unikatowej ścieżki do pliku.
'
' Jeżeli plik o podanej ścieżce nie istnieje, zwracana jest oryginalna
' ścieżka do pliku.
'
' Jeżeli plik o podanej ścieżce istnieje, zwracana jest oryginalna ścieżka po
' uprzednim dodaniu do nazwy pliku liczby porządkowej w nawiasie.
'
'
' Przykład:
' ---------------------------------------------------------------------------------
' * Jeżeli funkcja została wywołana dla ścieżki C:\test.txt, a w systemie plików nie
' ma jeszcze takiego pliku, zwracana jest ścieżka w oryginalnej postaci
' (C:\test.txt).
' * Jeżeli jednak istnieje już plik o takiej nazwie, leżący w tym samym folderze,
' zwrócona zostanie ścieżka C:\test (1).txt.
' * Jeżeli również taki plik już istnieje, zwrócona ścieżka będzie miała
' postać: C:\test (2).txt, itd.
'
'
' Uwaga: Funkcja nie sprawdza czy podana ścieżka do pliku jest prawidłowo skonstruowana.
' W przypadku, gdy do funkcji jest przekazywana niepoprawna ścieżka, jest ona
' zwracana bez żadnych zmian, ponieważ funkcja ustali, że plik o podanej ścieżce
' nie istnieje (w końcu nie może istnieć, skoro jest to nieprawidłowa ścieżka) i nie
' ma podstaw, żeby w jakikolwiek sposób ją zmieniać.
'
'
' --- Zmiany ----------------------------------------------------------------------------------------------
' 2012-12-02 mielk Utworzenie funkcji.
'**********************************************************************************************************
Public Function unikatowaSciezka(sciezka As String) As String
Const NAZWA_METODY As String = "unikatowaSciezka"
'------------------------------------------------------------------------------------------------------
Static objFSO As Object 'Późne wiązanie pozwala korzystać z funkcji nawet jeżeli
'nie jest załadowana biblioteka Microsoft Scripting Runtime.
Dim strRozszerzeniePliku As String
Dim strNazwaPliku As String
Dim strFolderNadrzedny As String
Dim strTempSciezka 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 plik o podanej ścieżce już istnieje. -----------------------------------------------|
If .FileExists(sciezka) Then '|
'|
'Jeżeli podana ścieżka już istnieje, funkcja przekształca ścieżkę wejściową w ten sposób, '|
'że dołącza do niej kolejne liczby w nawiasie. '|
strFolderNadrzedny = .GetParentFolderName(sciezka) '|
If Not VBA.right$(strFolderNadrzedny, 1) = "\" Then strFolderNadrzedny = _
strFolderNadrzedny & "\" '|
strNazwaPliku = .GetBaseName(sciezka) '|
strRozszerzeniePliku = "." & .GetExtensionName(sciezka) '|
'|
'------------------------------------------------------------------------------------| '|
Do '| '|
intLicznik = intLicznik + 1 '| '|
strTempSciezka = strFolderNadrzedny & strNazwaPliku & _
" (" & intLicznik & ")" & strRozszerzeniePliku '| '|
Loop While .FileExists(strTempSciezka) '| '|
'------------------------------------------------------------------------------------| '|
'|
unikatowaSciezka = strTempSciezka '|
'|
Else '|
'|
'Jeżeli nie znaleziony został plik o podanej nazwie, oznacza to, że nie istnieje, więc '|
'ścieżka wejściowa może być zwrócona bez dokonywania jakichkolwiek zmian. '|
unikatowaSciezka = sciezka '|
'|
End If '|
'-------- [If .FileExists(sciezka) Then] --------------------------------------------------------|
End With
End Function