Make directory, if it doesnt exist, from cell values and save workbook

Question

I'm trying to code a script where it takes values from 2 cells, make a directory if there isn't one yet and save a files using another cell's value.

I've started from code in this thread: Save excel Workbook in a new created folder with the Same names and adjusted the codes to what I think they need to be for my purpose, but I'm very much a novice in VBA... My code right now looks like this:

Sub SAVE()
Dim strFilename, strDirname, strPathname, strDefpath, strYear As String
 On Error Resume Next ' If directory exist goto next line

strFilename = Range("B2").Value 'New file name
strDirname = Range("B3").Value ' New directory name
strYear = Range("B4").Value 'New year name
strDefpath = "P:\PPE\Urenverwerking" 'Default path name

If IsEmpty(strDirname) Then Exit Sub
If IsEmpty(strFilename) Then Exit Sub
If IsEmpty(strYear) Then Exit Sub

MkDir strDefpath & "\" & strYear & "\" & strDirname
strPathname = strDefpath & "\" & strYear & "\" & strDirname & "\" & strFilename 'create total string

ActiveWorkbook.SaveAs Filename:=strPathname & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

This results in the code being ran (wait cursor shows), but nothing happens, while i expect there to be a new directory in P:\PPE\Urenverwerking\2019 with a file named from cell B2.

score 0 · Answer 1 · answered Apr 30 '19 at 08:59

I believe the problem is here:

MkDir strDefpath & "\" & strYear & "\" & strDirname

You want to create a subsubdirectory, while the subdirectory itself does not even exist.

Try the following:

MkDir strDefpath & "\" & strYear
MkDir strDefpath & "\" & strYear & "\" & strDirname

Make directory, if it doesnt exist, from cell values and save workbook

1 Answers1