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:
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
Hallo!
Schau dir die Prozedur CreateDirectory(...) in FileTools.bas (http://source.access-codelib.net/filedetails.php?repname=CodeLib+%28Entwurf%2C+branches%2Fdraft%29&path=%2Ffile%2FFileTools.bas) an:
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
Hallo
die API MakeSureDirectoryPathExists könnte helfen.
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal sPath As String) As Long
...
MakeSureDirectoryPathExists(PfadGesamt & "\")
Habs geschafft danke
Hallo,
wie lautet nun Dein Ergebniscode?
z.B. so?
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