Utwórz kompletną ścieżkę
by vbatools on Sep.22, 2011, under Excel, Outlook, Porady, Word
W wielu przypadkach mamy potrzebę osadzić nowy plik w odpowiedni katalog. O ile on istnieje, nie będzie problemów z zapisem, jednakże jeśli na drodze zapisu choć jeden z elementów ścieżki będzie nieprawidłowy (brak katalogu w ścieżce) to poniższa dokładnie odtworzy drogę zapisu.
Function MakeWholePath(Path As String, _ Optional PathWithFile As Boolean, _ Optional Prompt As Boolean) As Boolean 'MVP OShon from VBATools.pl Dim x&, PathToMake$, F%, K& For F = 1 To Len(Path) Path = Replace(Path, Mid$("/?""<>|*", F, 1), vbNullString) Next If PathWithFile = True Then K = 1 If FileExists(Path) = True Then If Prompt = True Then MsgBox "Ścieżka już istnieje!", _ vbExclamation, "VBATools.pl" MakeWholePath = True Exit Function End If On Error GoTo blad For x = LBound(Split(Path, "\")) To UBound(Split(Path, "\")) - K PathToMake = PathToMake & "\" & Split(Path, "\")(x) If Right$(PathToMake, 1) <> ":" Then If FileExists(Mid(PathToMake, 2, Len(PathToMake))) = False Then MkDir Mid(PathToMake, 2, Len(PathToMake)) MakeWholePath = True If Prompt = True Then MsgBox "Path was created.", _ vbInformation, "VBATools.pl" End If End If Next x Exit Function blad: MakeWholePath = False If Prompt = True Then MsgBox "Error: " & Err.Number & vbCr & _ Err.Description, vbCritical, "VBATools.pl" End Function
funkcja pomocnicza:
Function FileExists(FilePath As String) As Boolean On Error GoTo blad FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0 Exit Function blad: FileExists = False End Function
Opisać należy iż funkcja posiada 2 parametry opcjonalne.
- Pierwszy z nich to oznaczenie czy ścieżka zawiera na końcu nazwę pliku (nie podanie utworzy katalog o nazwie pliku podany w ścieżce),
- Drugi to informacja komunikatem (o pozytywnym utworzeniu lub porażce).
(c) Shon Oskar – www.VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.