VBA Tools

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 "Path has already been created!", _
 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.