'********************************************************************************************************** ' 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