Pfad erstellen mit MkDir

[Aggro600]

Ich möchte einen Ordner bei nicht vorhanden sein erstellen.
Nun kann es sein, dass auch der Ordner Darüber nicht vorhanden ist.

mit MkDir schaff ich es nur einen Ordner zu erstellen und nicht den Übergeordneten.

Zum Beispiel soll ...../2019/2 erstellt werden wenn 2019 noch nicht da ist.

In der Windows Kommandozeile klappt das auch nur in VBA nicht.

Hier mal der Code:

Code [Auswählen] Erweitern

Public Function DateipfadOeffnen(PfadId As String, PfadDatum As String, VorhandenerPfad As String) As String
'Textfelder müssen heißen "Tag_von" "SAP"
Dim PfadGesamt As String
'MsgBox VorhandenerPfad
If VorhandenerPfad = "" Then
'MsgBox "Nicht gespeichert"
    Dim Pfad As String
    Dim PfadJahr As String
    Dim PfadMonat As String
    'Dim PfadId As String
   
   
    'Grundpfad in dem die Unterpfade erstellt werden
    Pfad = "XXXXXXXXXXXXXXXXXXXXXXXX" 'Datenschutz
   
   
    Dim DatumArray() As String
   
   
    'Split (text_string, delimiter, limit, compare)
    DatumArray = Split(PfadDatum, ".")
    PfadJahr = DatumArray(2)
   
   
    PfadGesamt = Pfad & "\" & PfadJahr & "\" & PfadId
    'MsgBox PfadGesamt

Else
    'MsgBox "Gespeichert"
    PfadGesamt = VorhandenerPfad
   
End If
MsgBox PfadGesamt
If Dir(PfadGesamt, vbDirectory) <> "" Then
'If Dir(PfadGesamt, vbDirectory) = PfadGesamt Then

        'Verzeichnis vorhanden
        'MsgBox ("Öffne Explorer")
            Shell "Explorer.exe " & PfadGesamt, vbNormalFocus
        Else
        'Verzeichnis nicht vorhanden
              Dim strQuest As String

            strQuest = MsgBox("Das Verzeichnis existiert nicht " & vbCr & _
                              "soll ich es erstellen?", vbYesNo + vbQuestion, "Erstellen")
            'Wenn die Abfrage mit "Nein" bestätigt wird,
            'wird die Prozedur mit dem  Befehl "Exit Sub" abgebrochen.
            If strQuest = vbNo Then
                'MsgBox ("Ich habe es nicht erstellt."), , ("Abbruch")
                Exit Function
                End If
                MsgBox "Ich erstelle nun: " & PfadGesamt
                MkDir (PfadGesamt)
                Shell "Explorer.exe " & PfadGesamt, vbNormalFocus
            End If

'Rückgabewert der Funktion
DateipfadOeffnen = PfadGesamt

End Function


[Josef P.]

Hallo!

Schau dir die Prozedur CreateDirectory(...) in FileTools.bas an:

Code [Auswählen] Erweitern

Public Function CreateDirectory(ByVal FullPath As String) As Boolean

   Dim PathBefore As String

   If Right$(FullPath, 1) = "\" Then
      FullPath = Left$(FullPath, Len(FullPath) - 1)
   End If

   If DirExists(FullPath) Then 'Verzeichnis ist bereits vorhanden
     CreateDirectory = False
      Exit Function
   End If

   PathBefore = Mid$(FullPath, 1, InStrRev(FullPath, "\") - 1)
   If Not DirExists(PathBefore) Then
      If CreateDirectory(PathBefore) = False Then
         CreateDirectory = False
         Exit Function
      End If
   End If

   MkDir FullPath

   CreateDirectory = True

End Function

mfg
Josef

[daolix]

Hallo
die API MakeSureDirectoryPathExists könnte helfen.

Code [Auswählen] Erweitern


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

MakeSureDirectoryPathExists(PfadGesamt & "\")


[Aggro600]

Habs geschafft danke

[derArb]

Hallo,
wie lautet nun Dein Ergebniscode?

z.B. so?

Code [Auswählen] Erweitern

Option Compare Database
Option Explicit

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

' Legt einen kompletten Verzeichnispfad an
Private Sub btnCommand1_Click()
Dim Retval As Long

  ' Verzeichnis erstellen
  Retval = MakeSureDirectoryPathExists(Me.DeinTextfeld)
  If Retval = 0 Then
    MsgBox "Das Verzeichnis konnte nicht angelegt werden"
  Else
    MsgBox "Das Verzeichnis wurde angelegt !"
  End If
End Sub