Create necessary folders/directories from a path

[xlkeuk]

I've done a few searches on this, but I can't find a solution. My problem is this, I have a string that is a path of folders. If the penultimate folder or all the folders exist, there is no problem. What I am looking for is a simple piece of code that will produce the necessary folders from a given path.

    MkDir "C:\Documents and Settings\MyName\My Documents\2004\01\"

The above works fine if:
C:\Documents and Settings\MyName\My Documents\2004\
exists, but not if the 2004 folder doesn't exist.

Hope you can help. Many thanks.

 

[TryingToLearn]

not quite sure what you are looking for but simple would be:

On Error Resume Next
MkDir "C:\Documents and Settings\MyName\My Documents\2004"
MkDir "C:\Documents and Settings\MyName\My Documents\2004\01\"


or as many levels as you would need

 

[xlkeuk]

Sorry, but that's two strings, I want to do it from one path.

The path is a variable, so I don't know what it will be, and there may be many levels needing to be created.

 

[Greg Truby]

I wrote SenderoLuminoso several years ago and could probably improve the code somewhat, but it works - http://www.mrexcel.com/board2/viewtopic.php?t=73516&highlight=senderoluminoso

 

[xlkeuk]

Is it not possible to have a string that is a path and to create the folders (more than one) that don't already exist?

I have been looking for a solution to this for ages. All I seem to be able to find is solutions that create one folder assuming the rest exist, and huge blocks of code that *must* be unnecessary. Am looking to put the blocks of the path into an array and perform MkDir functions in sequence...

I found this block of code, but it won't make the folder if any of them *do* exist!

Sub MultiMkDir()
   Dim iCounter
   Dim sPath As String, sTxt As String
   sPath = InputBox("Bitte Pfad angeben:", , "c:\mypath")
   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
      On Error GoTo ErrorHandler
      MkDir sTxt
   Loop
   Exit Sub
ErrorHandler:
   If Err = 75 Then
      Beep
      MsgBox "Verzeichnis besteht schon!"
   End If
End Sub

 

[Greg Truby]

That's what SenderoLuminoso does. Pass the path to it as a string. If that path does not exist, it will create it. If the path is found/created then it returns true and you're safe to proceed. If it cannot find nor create the path passed to it, it returns false and you know not to proceed.

If Not SenderoLuminoso("C:\this\path\is\really\long\") Then
MsgBox "Could not create path needed"
Exit Sub
End If

 

[xlkeuk]

ok, this seems to work. Hope it's of help to someone...

Sub MultiMkDir()
Dim iCounter
Dim sPath As String, sTxt As String
sPath = "C:\Documents and Settings\MyName\My Documents\2004\01\"
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
On Error Resume Next
MkDir sTxt
Loop
End Sub

Credit goes to:
http://www.herber.de/mailing/volumina/015298x.htm

 

[SydneyGeek]

Hi, probably a bit late but it didn't upload when I sent it a couple of days ago. This code checks to see whether the folder exists before trying to create it. Pathname is easy to update -- it's a constant at the top of the module.
The code assumes a list of names starting at D2 on the active sheet. Update as required.

Option Explicit
Const Pathname = "C:\Test"

Sub FolderNav()
Dim c As Range, MyStr As String
If Not PathExists(Pathname) Then
    MkDir Path
End If
ChDir Pathname
[D2].Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
'Create folders and files
For Each c In Selection
  MyStr = c.Value
  If Not PathExists(Pathname & "\" & MyStr) Then
    MkDir MyStr
  End If
  MyStr = MyStr & "\" & c.Value & ".xls"
  ActiveWorkbook.SaveAs MyStr
  MsgBox ActiveWorkbook.Path
Next c
End Sub

Function PathExists(pName) As Boolean
'From John Walkenbach
'returns TRUE if path exists
Dim X As String
On Error Resume Next
X = GetAttr(pName) And 0
If Err = 0 Then PathExists = True _
    Else PathExists = False
End Function

Denis