Can you create a VBA macro that checks if folder exists and if not creates one

Not sure what you meant by

saves down a file to a folder with the corresponding month and year

But the following code will create the folder defined in the strFolderPath variable if it doesnt already exist.

Option Explicit

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Sub Demo()
    Dim strFolderPath As String
    strFolderPath = "C:\2016\10-Oct 2016\"
    If Dir(strFolderPath, vbDirectory) <> vbNullString Then
        MakeSureDirectoryPathExists strFolderPath
    End If
End Sub

Select allOpen in new window

I think that code works, but only if you change <> to =

oops ;-)

If you know the parent folder will exist, then you can create the new date based child pretty simply like below.  In addition, if wanted a little more control over things then you could use the FileSystemObject as well, happy to share an example of that as well...

strDir = "S:\2016\10-OCT-2016\" 
If Dir(strDir, vbDirectory) = "" Then MkDir strDir

Select allOpen in new window

~bp

Maybe you want the name to be dynamic

Option Explicit

Public Sub TestFolderExists()
 Dim sFullPath As String
 
 sFullPath = "S:" & Year(Date) & Application.PathSeparator & Format(Date, "dd-mmm yyyy")
 If Not Dir(sFullPath, vbDirectory) = vbNullString Then
        MsgBox sFullPath & " exists!"
    Else: MkDir (sFullPath)
    End If

End Sub

Select allOpen in new window

I still like the first solution better (because creating the subfolder is not depended on parent folder's existence, and therefore more fool proof). The asker might have a hard time figuring out this problem right after new year's eve.

Hi.

Please, be patient if my English language level is not so good.

Try this:

Dim fso As Scripting.FileSystemObject
    Dim ArrPath As Variant
    Dim n As Integer
    
    Dim sFullPath As String
    
    Set fso = New Scripting.FileSystemObject
    
    sFullPath = CurrentProject.Path & "\" & Year(Date) & "\" & Format(Date, "dd-mmm yyyy")

    ArrPath = Split(sFullPath, "\")
    
    sFullPath = ArrPath(0)
    
    For n = 1 To UBound(ArrPath)
        sFullPath = sFullPath & "\" & ArrPath(n)
        If Not fso.FolderExists(sFullPath) Then
            fso.CreateFolder (sFullPath)
        End If
    Next n
    Set fso = Nothing  

Select allOpen in new window

You only require a reference to Microsoft Scripting Host (included) and doesn't need any external library.

This routine hasn't problems if the full path not exists, because checks/create the full path.


Also, if you are using a network drive, you can check this and use the real network resource (ServerName\Root Path) instead of mapped names by using the Scripting. FileSystemObject .


Best regards.

Antonio.
Barcelona (Spain).

Pleased to help.