Home > database >  VBA Create Subfolder In Today's Folder
VBA Create Subfolder In Today's Folder

Time:08-19

I have a statement that creates a new folder with today's date, and that works without fault.

I now want to create a subfolder within that folder titled "Validation". My issue is that I can't figure out how to define the path if the main folder will never have the same name (format = yyyymmdd). Any advice on how to write that one?

Here is what I have currently:

Dim Path As String
Dim d As String

Path = "C:\Maintenance\Validation\"
    If Len(Dir(Path, vbDirectory)) = 0 Then
        MsgBox "Path does not exist.", vbCritical
        Exit Sub
    End If

d = Format(Date, "yyyymmdd")
    If Len(Dir(Path & d, vbDirectory)) = 0 Then MkDir (Path & d)
ActiveWorkbook.SaveAs Filename:=Path & d & "\" & d & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

I am fairly new to VBA/Excel, so I'm reaching out for a little help.

Thanks!

CodePudding user response:

Add another check and create the subfolder if missing:

Path = "C:\Maintenance\Validation\"
d = Format(Date, "yyyymmdd")

If Len(Dir(Path & d, vbDirectory)) = 0 Then MkDir  Path & d
If Len(Dir(Path & d & "\Validation", vbDirectory)) = 0 Then MkDir  Path & d & "\Validation"

You can clean it up a bit by pushing the "check/create" out into a separate sub:

Sub tester()
    Dim path As String, d As String

    path = "C:\Maintenance\Validation\"
    d = Format(Date, "yyyymmdd")

    EnsureFolder path & d
    EnsureFolder path & d & "\Validation"

End Sub


'create a folder if it doesn't already exist
Sub EnsureFolder(p As String)
    If Len(Dir(p, vbDirectory)) = 0 Then MkDir p
End Sub

CodePudding user response:

You can do that by adding another If statement.

Sub CreateDir()

Dim Path As String
Dim d As String

Path = "C:\Users\hamza\Desktop\RT\DATABASE\ipynb\"
    If Len(Dir(Path, vbDirectory)) = 0 Then
        MsgBox "Path does not exist.", vbCritical
        Exit Sub
    End If

d = Format(Date, "yyyymmdd")
folder = Path & d

    If Len(Dir(Path & d, vbDirectory)) = 0 Then MkDir (Path & d)
    subfolder = folder & "\Validation"
    If Len(Dir(subfolder, vbDirectory)) = 0 Then MkDir (subfolder)
    
ActiveWorkbook.SaveAs Filename:=folder & "\" & d & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

End Sub

This will create the following tree :

Path
---------20220818
-----------------------20220818.xlsm
-----------------------Validation

CodePudding user response:

Thanks @L'Artiste and @TimWilliams !

That did the trick, I appreciate your help/insight :)

  • Related