recursively creating folders

[DavidJA]

Hey all. Maybe my brain is dead today, but anyway, I can't figure out how to recursively create a folder.

EG:

If I want to create a folder called c:\Folder1\Folder2\Folder3\Folder4 and Folder1 does not exist, then I need to create Folder1, then I need to create Folder2, then Folder3 and finaly Folder4 can be created.

But how can I do this in code?

I'm sure there must be some examples of this somewhere. All feedback appriciated.

 

[sunaj]

-----------------------------------------------------
Dim MyDir As String, i As Long
MyDir = "c:\"
For i = 1 To 4
MyDir = MyDir & "folder" & CStr(i) & "\"
MkDir MyDir
Next i
-----------------------------------------------------
-But its not recursive. Recursive procedures are usually used to map already existing structures. E.g. mapping the folders on a drive (faq222-867 method 2) Sunaj
'The gap between theory and practice is not as wide in theory as it is in practice'

 

[JustinEzequiel]

try

Option Explicit

Sub main()
  If BuildPath("J:\1\2\3\4\5") Then
    MsgBox "ok"
  Else
    MsgBox "not ok"
  End If
End Sub

Private Function BuildPath(ByVal sPath As String) As Boolean
  Dim oFSO As Object
  Dim sParent As String
  
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  If oFSO.FolderExists(sPath) Then
    BuildPath = True
  Else
    sParent = oFSO.GetParentFolderName(sPath)
    If oFSO.FolderExists(sParent) Then
      BuildPath = Not oFSO.CreateFolder(sPath) Is Nothing
    Else
      If BuildPath(sParent) Then
        BuildPath = Not oFSO.CreateFolder(sPath) Is Nothing
      End If
    End If
  End If
  Set oFSO = Nothing
End Function

Note that this has no error handling and may generate an 'out of stack space error' if the drive does not exist.
I'm sure others can give you better code.
Catch you tomorrow as I have to go.

BTW, another thing you may want to look at is the SHFileOperation API.
I've used it before to copy files and you could set it to create the full folder path if it does not exist.

 

[cj44]

'Here is code I have used in the past (it works on UNC
'paths as well):

Public Function MkFullDir(strDir As String) As Boolean
On Error GoTo err_MkFullDir
Dim strParentDir As String

MkFullDir = False
strParentDir = ParentDir(strDir)
If Len(strParentDir) > 0 Then 'Not At root or share directory
'Create parent directory:
If Not MkFullDir(strParentDir) Then Exit Function
If Len(Dir(strDir, vbDirectory)) = 0 Then
'Create current dir:
MkDir strDir
End If
End If
MkFullDir = True
Exit Function
err_MkFullDir:
End Function

Public Function ParentDir(strDir As String) As String
Dim intP As Integer

ParentDir = vbNullString
If strDir Like "[A-Z]:\" Then Exit Function 'Return null string
intP = InStrRev(strDir, "\&quot
If Left(strDir, 2) = "\\" Then 'UNC
If intP = InStr(3, strDir, "\&quot Then
'Share, e.g. \\Server1\Personnel
Exit Function 'Return null string
End If
End If
If intP = 0 Then Exit Function 'Return null string
ParentDir = Left(strDir, intP - 1)
If Right(ParentDir, 1) = ":" Then ParentDir = ParentDir & "\"
End Function

 

[MichaelRed]

'Recursion has somewhat a similar property to a "Stack", for those _
MATURE enough to recall the term from days of yore, so creating the _
directory 'structure' should be a simple matter a of push-pop exercise _
at least as long as the folder names fit nicely into a pattern - as _
suggested by DavidJA

Public Function basMkDir(StrtPath As String, _
                         Dir2Make As String, _
                         Num2Make As Integer) _
                         As Boolean

    'Michael Red    5/5/02
    '? basMkDir("C:\", "A_MyFldr", 4)
    'Tek-Tips thread222-307361
    'Recursive generation of Directories (a.k.a. FOLDERS)

    Dim MyDir As String
    Dim StrPath As String
    Dim FullPath As String
    Dim Idx As Integer

    MyDir = Dir(StrtPath & Dir2Make & Trim(Str(Num2Make)), vbDirectory)
    If (MyDir = "") Then
        'Doesn't Exist,
        'If Num not @ zero, Call MeSelf to check next higher one
        Idx = 1
        FullPath = StrtPath
        Do While Idx <= Num2Make
            FullPath = FullPath & Dir2Make & Trim(Str(Idx)) & &quot;\&quot;
            Idx = Idx + 1
        Loop
        FullPath = Left(FullPath, Len(FullPath) - 1)

        If (Num2Make > 1) Then
            MyDir = basMkDir(StrtPath, Dir2Make, Num2Make - 1)
            GoTo Exit1
         End If
    End If

Exit1:
    MkDir (FullPath)

End Function

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[JustinEzequiel]

DavidJA,

here is an example for moving a file using SHFileOperation.
although this is not what you asked for, this method will also build the destination directory structure if it does not already exists.

in the example, the code moves a file "C:\test.txt"
to "J:\1\2\3\4\5\6\7\test.txt", creating the directory structure "J:\1\2\3\4\5\6\7" as it does so.

Option Explicit

Private Type SHFILEOPSTRUCT
  hWnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAborted As Boolean
  hNameMaps As Long
  sProgress As String
End Type

Private Const FO_MOVE = &H1
Private Const FOF_NOCONFIRMATION = &H10
Private Const FOF_NOCONFIRMMKDIR = &H200

Private Declare Function SHFileOperation _
                Lib "shell32.dll" _
                Alias "SHFileOperationA" _
                (lpFileOp As SHFILEOPSTRUCT) As Long

Private Sub Command1_Click()
  Dim SHFileOp As SHFILEOPSTRUCT
  Dim nRet As Long
  
  With SHFileOp
    .wFunc = FO_MOVE
    .pFrom = "C:\test.txt" & String$(2, 0)
    .pTo = "J:\1\2\3\4\5\6\7\test.txt" & String$(2, 0)
    .fFlags = FOF_NOCONFIRMATION Or _
              FOF_NOCONFIRMMKDIR
  End With
  
  nRet = SHFileOperation(SHFileOp)
  
  If nRet = 0 Then
    MsgBox "File moved", vbInformation
  Else
    MsgBox "SHFileOperation returned " & nRet, vbExclamation
  End If
End Sub