CODEWITHSUNDEEP
vbaexcel
czchlong
czchlong

Reputation: 2594

FileSystemObject.CreateFolder to create directory and subdirectories

I would like to create a directory and a subdirectory with the following code:

Public fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
fso.CreateFolder ("C:\Users\<my_username>\DataEntry\logs")

I am trying to create nested directories. In this case, the DataEntry directory would not exist, so essentially I would like to create 2 directories, DataEntry\logs under C:\Users\<username>

If I enter command prompt, I can create that directory with mkdir without any issues. However, I simply cannot get VBA to create that folder and I get:

Run-time error '76':

Path not found

I am using Excel VBA 2007/2010

Upvotes: 16

Views: 28417

Answers (4)

Harry White Dewulf
Harry White Dewulf

Reputation: 41

This is how I normally do it:

Public Function FSOCreateFolder2(strPath As String) As Boolean
    Static FSO As New FileSystemObject
    If Not FSO.FolderExists(FSO.GetParentFolderName(strPath)) Then
        'walk back up until you find one that exists
        FSOCreateFolder2 FSO.GetParentFolderName(strPath)
    End If
    FSO.CreateFolder strPath
End Function

I prefer to check the arguments and the existence of the path outside of a recursive function.

Upvotes: 3

Tavious
Tavious

Reputation: 51

Agree with MarkD's suggestion to utilize recursion, it was the code I came here looking to find. In a scenario where the path provided uses a nonexistent root folder it will result in an infinite loop. Adding to MarkD's solution to check for zero length path.

Function CreateFolderRecursive(path As String) As Boolean
    Static FSO As FileSystemObject
 
    'Initialize FSO variable if not already setup
    If FSO Is Nothing Then Set lFSO = New FileSystemObject

    'Is the path paramater populated
    If Len(path) = 0 Then
      CreateFolderRecursive = False
      Exit Function
    End If

    'If the path exists as a file, the function fails.
    If FSO.FileExists(path) Then
        CreateFolderRecursive = False
        Exit Function
    End If
 
    'If the path already exists as a folder, don't do anything and return success.
    If FSO.FolderExists(path) Then
        CreateFolderRecursive = True
        Exit Function
    End If
 
    'recursively create the parent folder, then if successful create the top folder.
    If CreateFolderRecursive(FSO.GetParentFolderName(path)) Then
        If FSO.CreateFolder(path) Is Nothing Then
            CreateFolderRecursive = False
        Else
           CreateFolderRecursive = True
        End If
    Else
        CreateFolderRecursive = False
    End If
End Function

Upvotes: 3

MarkD
MarkD

Reputation: 191

tigeravatar's looping answer might work, but it's a bit hard to read. Instead of micromanaging the string handling yourself, the FileSystemObject has path manipulation functions available, and recursion is slightly easier to read than a loop.

Here is the function I use: 

Function CreateFolderRecursive(path As String) As Boolean
    Dim FSO As New FileSystemObject

    'If the path exists as a file, the function fails.
    If FSO.FileExists(path) Then
        CreateFolderRecursive = False
        Exit Function
    End If

    'If the path already exists as a folder, don't do anything and return success.
    If FSO.FolderExists(path) Then
        CreateFolderRecursive = True
        Exit Function
    End If

    'recursively create the parent folder, then if successful create the top folder.
    If CreateFolderRecursive(FSO.GetParentFolderName(path)) Then
        If FSO.CreateFolder(path) Is Nothing Then
            CreateFolderRecursive = False
        Else
            CreateFolderRecursive = True
        End If
    Else
        CreateFolderRecursive = False
    End If
End Function

Upvotes: 17

tigeravatar
tigeravatar

Reputation: 26670

Need to create each folder one at a time. You can use code like this to do so:

Sub tgr()

    Dim strFolderPath As String
    Dim strBuildPath As String
    Dim varFolder As Variant

    strFolderPath = "C:\Users\<my_username>\DataEntry\logs"

    If Right(strFolderPath, 1) = "\" Then strFolderPath = Left(strFolderPath, Len(strFolderPath) - 1)
    For Each varFolder In Split(strFolderPath, "\")
        If Len(strBuildPath) = 0 Then
            strBuildPath = varFolder & "\"
        Else
            strBuildPath = strBuildPath & varFolder & "\"
        End If
        If Len(Dir(strBuildPath, vbDirectory)) = 0 Then MkDir strBuildPath
    Next varFolder

    'The full folder path has been created regardless of nested subdirectories
    'Continue with your code here

End Sub

Upvotes: 8

Related Questions