'********************************************************************************************************** ' Nazwa: czyMozliwyZapisDoFolderu ' Autor: mielk | 2012-12-02 ' ' Opis: Funkcja sprawdzająca czy aktualny użytkownik ma prawo do zapisu w danym folderze, ' a więc może dodawać, usuwać i modyfikować pliki w tym folderze. ' ' Argumenty: ' sciezkaDoFolderu Ścieżka folderu, który ma zostać sprawdzony pod kątem możliwości zapisu. ' ' Zwraca: ' Boolean True - jeżeli użytkownik ma uprawnienia aby dodawać, usuwać i modyfikować pliki ' w danym folderze. ' False - w innym przypadku. ' ' Wyjątki: ' NieistniejacyFolder Zwracany, jeżeli folder podany jako argument wejściowy nie istnieje. ' ' ' ' --- Zmiany ---------------------------------------------------------------------------------------------- ' 2012-12-02 mielk Utworzenie funkcji. '********************************************************************************************************** Public Function czyMozliwyZapisDoFolderu(sciezkaDoFolderu As String) As Boolean Const NAZWA_METODY As String = "czyMozliwyZapisDoFolderu" Const NAZWA_PLIKU_TEMP As String = "TestFile.txt" '------------------------------------------------------------------------------------------------------ Static objFSO As Object 'Późne wiązanie pozwala korzystać z funkcji nawet jeżeli 'nie jest załadowana biblioteka Microsoft Scripting Runtime. Dim strPlikTemp 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 '| '----------------------------------------------------------------------------------------------------| 'Sprawdź czy podany folder w ogóle istnieje. --------------------------------------------------------| If objFSO.FolderExists(sciezkaDoFolderu) Then '| '| 'Stwórz pełną ścieżkę do pliku pomocniczego. '| strPlikTemp = sciezkaDoFolderu '| If Not VBA.right$(sciezkaDoFolderu, 1) = "\" Then strPlikTemp = strPlikTemp & "\" '| strPlikTemp = unikatowaSciezka(strPlikTemp & NAZWA_PLIKU_TEMP) '| '| '| 'Spróbuj utworzyć plik pomocniczy. ------------------------------------------------------| '| On Error Resume Next '| '| Call objFSO.CreateTextFile(strPlikTemp) '| '| On Error GoTo 0 '| '| '----------------------------------------------------------------------------------------| '| '| '| 'Funkcja sprawdza czy tymczasowy plik został utworzony. Jeżeli tak, oznacza to, że ------| '| 'użytkownik ma uprawnienia do zapisu do podanego folderu. '| '| 'W takiej sytuacji funkcja zwraca wartość True i kasuje plik tymczasowy. '| '| If objFSO.FileExists(strPlikTemp) Then '| '| czyMozliwyZapisDoFolderu = True '| '| Call objFSO.usunPlik(strPlikTemp) '| '| End If '| '| '----------------------------------------------------------------------------------------| '| '| Else '| '| GoTo NieistniejacyFolder '| '| End If '| '-------- [If objFSO.FolderExists(sciezkaDoFolderu) Then] -------------------------------------------| '========================================================================================================== ExitPoint: Exit Function '---------------------------------------------------------------------------------------------------------- NieistniejacyFolder: 'Obsługa błędów dla sytuacji, kiedy podany folder nie istnieje. GoTo ExitPoint End Function '********************************************************************************************************** ' 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