VBATools

Utwórz kompletną ścieżkę

by 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.

:, ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of marcinmachalowski
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała