'********************************************************************************************************** ' Nazwa: utworzFolder ' Autor: mielk | 2012-12-02 ' ' Opis: Funkcja sprawdza czy podany folder istnieje. Jeżeli tak, zwracane jest odniesienie ' do tego folderu. ' Jeżeli nie, folder jest tworzony i również zwracane jest odniesienie do niego. ' ' Argumenty: ' sciezkaDoFolderu Ścieżka folderu, do którego odniesienie ma być zwrócone. ' ' Zwraca: ' Object Obiekt typu Scripting.Folder reprezentujący podaną ścieżkę. ' ' Jeżeli folder już istnieje, funkcja zwraca referencję do tego folderu nie ' podejmując żadnych dodatkowych akcji. ' ' Jeżeli folder nie istnieje, funkcja tworzy go i zwraca odniesienie do tego folderu. ' ' Jeżeli folder nie istnieje i nie może być utworzony (np. z powodu braku uprawnień ' lub niepoprawnej ścieżki) zwracane jest Nothing. ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2012-12-02 mielk Utworzenie funkcji. '********************************************************************************************************** Public Function utworzFolder(sciezkaDoFolderu As String) As Object Const NAZWA_METODY As String = "utworzFolder" '------------------------------------------------------------------------------------------------------ Static objFSO As Object 'Późne wiązanie pozwala korzystać z funkcji nawet jeżeli 'nie jest załadowana biblioteka Microsoft Scripting Runtime. Dim strNazwaDysku As String Dim strFolderNadrzedny 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 '| '----------------------------------------------------------------------------------------------------| With objFSO 'Jeżeli podany folder już istnieje, jest przypisywany do zmiennej [utworzFolder] i zwracany -----| 'jako wynik funkcji. '| If .FolderExists(sciezkaDoFolderu) Then '| '| Set utworzFolder = .getFolder(sciezkaDoFolderu) '| '| Else '| '| 'Sprawdź czy istnieje nazwa dysku podana w ścieżce źródłowej. ---------------------------| '| strNazwaDysku = .GetDriveName(sciezkaDoFolderu) '| '| If .DriveExists(strNazwaDysku) Then '| '| '| '| 'Uzyskaj nazwę folderu nadrzędnego. ---------------------------------------------| '| '| strFolderNadrzedny = .GetParentFolderName(sciezkaDoFolderu) '| '| '| If Not .FolderExists(strFolderNadrzedny) Then '| '| '| 'Jeżeli folder nadrzędny nie istnieje, funkcji [utworzFolder] jest '| '| '| 'wywoływana rekurencyjnie i tworzy ten folder. '| '| '| Call utworzFolder(strFolderNadrzedny) '| '| '| End If '| '| '| '--------------------------------------------------------------------------------| '| '| '| '| '--------------------------------------------------------------------------------| '| '| On Error Resume Next '| '| '| Call .utworzFolder(sciezkaDoFolderu) '| '| '| Set utworzFolder = .getFolder(sciezkaDoFolderu) '| '| '| On Error GoTo 0 '| '| '| '--------------------------------------------------------------------------------| '| '| '| '| End If '| '| '-------- [If .DriveExists(strNazwaDysku) Then] -----------------------------------------| '| '| End If '| '------------ [If .FolderExists(sciezkaDoFolderu) Then] -----------------------------------------| End With End Function