Diesmal Ordner anlegen!

Forumthread: Diesmal Ordner anlegen!

29.12.2003 16:28:09

Andre

Danke nochmals, für eure Hilfe, aber hab schon wieder ´n neues Problem:

Ich möchte jetzt den Pfad mit folgenden Zeilen generieren, sollte er nicht existieren. Das funktioniert auch solange ich keine Unterordner angebe!

Also bei C:\test kein Problem, aber C:\test\unterordner nicht!

Public


Sub Ordner_vorhanden()
Dim fs As Object
Dim Prüfen_Pfad As String
Prüfen_Pfad = [Kontrolle!K27]
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(Prüfen_Pfad) Then GoTo 1
Exit Sub
1:
Dim mldg As Integer
mldg = MsgBox("Der Pfad " & Prüfen_Pfad & " existiert nicht! Möchten sie ihn jetzt generieren?", vbYesNo, "Überschrift", "", 0)
If mldg = 6 Then GoTo 2
Exit Sub
2:
'On Error Resume Next
MkDir Prüfen_Pfad
'On Error GoTo 0
'End If
End Sub

Gruß Andre

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Diesmal Ordner anlegen!

29.12.2003 16:33:05

ChrisL
Okay, aber ...

29.12.2003 16:44:50

Andre
AW: Okay, aber ...

29.12.2003 16:57:12

ChrisL
Alles klar, noch etwas modifiziert und schon funzt

29.12.2003 17:06:32

Andre

AW: Diesmal Ordner anlegen!

29.12.2003 16:33:05

ChrisL

Hi Andre

Siehe Antwort unten...
https://www.herber.de/forum/messages/356748.html

Gruss
Chris

Okay, aber ...

29.12.2003 16:44:50

Andre

Sorry, hatte ich noch nicht gesehen! Aber eine Sache gibt´s da trotzdem:

Funktioniert soweit, wird alles generiert, aber leider überprüft der Code nur pb der erste Ordner existiert. D.H.:

C:\test\unterordner1 wird generiert, aber C:\test\unterordner2 nicht mehr, weil C:\test bereits existiert!

Kann man da auch was machen?

Gruß Andre

AW: Okay, aber ...

29.12.2003 16:57:12

ChrisL

Hi Andre

Hast recht, musste den Code noch anpassen. Kopieren geht über studieren, galt in diesem Fall leider nicht.

Option Explicit


Sub test()
Call MultiMkDir("C:\test\test\test\test")
End Sub


Sub MultiMkDir(sPath As String)
Dim iCounter As Byte
Dim sTxt As String
Dim fs As Object
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
iCounter = 4
Do While InStr(iCounter, sPath, "\") > 0
sTxt = Left(sPath, InStr(iCounter, sPath, "\") - 1)
iCounter = InStr(iCounter, sPath, "\") + 1
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(sTxt) Then MkDir sTxt
Loop
End Sub

Gruss
Chris

Alles klar, noch etwas modifiziert und schon funzt

29.12.2003 17:06:32

Andre

So geht´s:


Sub MultiMkDir()
Dim iCounter As Byte
Dim sTxt As String
Dim fs As Object
Dim sPath As String
sPath = [Kontrolle!K27]
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
iCounter = 4
Do While InStr(iCounter, sPath, "\") > 0
sTxt = Left(sPath, InStr(iCounter, sPath, "\") - 1)
iCounter = InStr(iCounter, sPath, "\") + 1
Set fs = CreateObject("Scripting.FileSystemObject")
If Not fs.folderexists(sTxt) Then MkDir sTxt
Loop
End Sub

Danke für deine Hilfe.

Gruß Andre

Beliebteste Forumthreads (12 Monate)

Forumthread: Diesmal Ordner anlegen!

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread