AW: Prüfen ob Verzeichnis vorhanden ist
05.08.2021 18:39:53
Peter
Oder eben so: Beliebig viele Ordner im Pfad neu erzeugen:
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal lpPath As String) As Long
Sub Test()
Dim strPath As String
strPath = "C:\Philipp\Material\2021"
If Not DirPruefenErzeugen(strPath) Then
'Dann gab es Fehler
'Code...
Else
'Alles war OK
'Code...
End If
End Sub
Function DirPruefenErzeugen(strPath As String) As Boolean
'Testet, ob Verzeichnis strPath existiert
' - Wenn ohne LW, nehme LW des Workbooks,
' - wenn relativ (also ohne "\" oder ":\" am Anfang suche/erzeuge ab Pfad des Workbooks
'Der ggf. erweiterte Pfad wird in strPath zurückgegeben
'Wenn nicht versucht er ihn zu erzeugen
'Kommt zurück mit 1, wenn OK war bzw. 0 bei Fehler
Dim strSubDirs() As String, intI As Integer
Dim Retval As Long
If Len(strPath) = 0 Then
MsgBox "FEHLER: Der übergebene Pfad ist leer!", vbOKOnly + vbCritical, "DirPruefenErzeugen"
DirPruefenErzeugen = False
Exit Function
End If
If Right$(strPath, 1) "\" Then strPath = strPath & "\"
If Mid$(strPath, 2, 1) ":" Then
If Left$(strPath, 1) "\" Then
strPath = ThisWorkbook.Path & "\" & strPath
Else
strPath = Left$(ThisWorkbook.Path, 2) & strPath
End If
End If
DirPruefenErzeugen = MakeSureDirectoryPathExists(strPath)
If Not DirPruefenErzeugen Then _
MsgBox "FEHLER: Ich konnte das Verzeichnis" & vbLf & _
"""" & strPath & """" & vbLf & _
"nicht erzeugen!", vbOKOnly + vbCritical, "DirPruefenErzeugen"
End Function
Ob und wo du Fehler abfängst und Meldung macht kannst du ja selber entscheiden...
