(-hg)

Einen Pfad mit mehreren Ebenen in der Tiefe auf einen Schlag anzulegen, ist mit der Visual Basic-Funktion MkDir ein recht mühsames Unterfangen. Wollten Sie beispielsweise der Pfad "c:\abc\def\ghi" anlegen, wenn selbst "c:\abc" noch nicht existiert, sähe das etwa so aus:

On Error Resume Next
MkDir "c:\abc"
MkDir "c:\abc\def"
MkDir "c:\abc\def\ghi"
On Error GoTo 0

So schon etwas aufwändig, würde es noch aufwändiger, wenn Sie das als allgemein verwendbare Funktion implementieren wollten:

Function CreatePathDeep(NewPath As String) As Boolean
  Dim nNewPath As String
  Dim nStart As Integer

  nNewPath = Trim$(NewPath)
  If Left$(nNewPath, 2) = "\\" Then
    If Len(nNewPath) > 6 Then
      nStart = 7
    Else
      Exit Function
    End If
  ElseIf Mid$(nNewPath, 2, 2) = ":\" Then
    nStart = 4
  Else
    Exit Function
  End If
  If nStart Then
    Do
      nPos = Instr(nStart, nNewPath, "\")
      If nPos Then
        On Error Resume Next
        MkDir Left$(nNewPath, nPos - 1)
        On Error GoTo 0
      Else
        On Error Resume Next
        MkDir nNewPath
        If Err.Number = 0 Then
          CreatePathDeep = True ' Erfolg
        End If
        On Error GoTo 0
      End If
    Loop While nPos
  End If
End Function

Vor Windows 98 können Sie mit der Funktion CreatePathDeep einen neuen Pfad mit mehreren Ebenen in der Tiefe anlegen

Für Windows-Versionen vor Windows 98 werden Sie nicht darum herum kommen, das so zu implementieren. Ab Windows 98 und unter Windows NT können Sie jedoch eine API-Funktion aus einer der System-DLLs (imagehlp.dll) verwenden.

Die Funktion MakeSureDirectoryPathExists hält das Versprechen ihres Namens. Sie stellt sicher, dass der als Parameter übergebene Pfad nach ihrem Aufruf tatsächlich existiert - selbst wenn sie ihn erst anlegen muss. Das heißt - sie versucht zumindest, das Versprechen zu halten. Natürlich kann auch sie gegen nicht bereite Laufwerke oder Netzwerkpfade nichts ausrichten. Und ohne die entsprechenden Berechtigungen wird auch sie keine Pfade anlegen können. Den Erfolg meldet sie mit dem Rückgabewert 1 - bei Misserfolg ist dieser 0.

Sie erwartet allerdings einen abschließenden "\" bei der Übergabe des anzulegenden Pfades. Anderenfalls nimmt sie an, dass der letzte Teil ein Dateiname sein könnte und traut sich daher nicht, diesen Teil als Pfadbestandteil anzulegen. So rufen Sie sie zum Beispiel auf und prüfen den Erfolg:

Private Declare Function MakeSureDirectoryPathExists _
 Lib "imagehlp.dll" (ByVal lpPath As String) As Long

' ...

If Not (CBool(MakeSureDirectoryPathExists("c:\abc\def\ghi\") Then
  MsgBox "Pfad konnte nicht angelegt werden."
End If

Mit einem simplen Aufruf der API-Funktion MakeSureDirectoryPathExists legen Sie einen neuen Pfad mit mehreren Ebenen in der Tiefe an

Wenn Sie die Funktion benötigen, um beispielsweise eine Datei, deren Zielpfad und Name in einem String zusammen vorliegen, in genau diesen Zielpfad zu kopieren, können Sie sich die Vorsicht der Funktion zunutze machen: Sie können den Pfadstring (eben einschließlich des Dateinamens) an sie übergeben, ohne ihn zuvor erst in Pfad und Dateinamen zerlegen zu müssen.

Wenn Sie sich jedoch nicht bei jedem Aufruf um den abschließenden "\" kümmern wollen, verpacken Sie die API-Funktion in eine eigene Funktion, CreatePath, die automatisch den abschließenden "\" hinzufügt, falls er fehlen sollte:

Private Declare Function MakeSureDirectoryPathExists _
 Lib "imagehlp.dll" (ByVal lpPath As String) As Long

Public Function CreatePath(NewPath As String) As Boolean
  Dim nNewPath As String
  
  nNewPath = Trim$(NewPath)
  If Right$(nNewPath, 1) <> "\" Then
    nNewPath = nNewPath & "\"
  Else
    nNewPath = nNewPath
  End If
  CreatePath = CBool(MakeSureDirectoryPathExists(nNewPath))
End Function

Die Funktion CreatePath vereinfacht den Aufruf der API-Funktion MakeSureDirectoryPathExists

Copyright © 1999 - 2009 Harald M. Genauck, ip-pro gmbh  /  Impressum