Создайте каталог, если он не существует, из значений ячеек и сохраните книгу

Question

Я пытаюсь написать скрипт, в котором он принимает значения из 2 ячеек, создать каталог, если его еще нет, и сохранить файлы, используя значение другой ячейки.

Я начал с кодав этой теме: Сохраните книгу Excel в новой созданной папке с такими же именами и скорректируйте коды так, как мне кажется, они должны быть для моей цели, но я очень новичок в VBA ..Мой код сейчас выглядит следующим образом:

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

Это приводит к запуску кода (показывает курсор ожидания), но ничего не происходит, хотя я ожидаю, что в P: \ PPE \ будет новый каталогUrenverwerking \ 2019 с именем файла из ячейки B2.

Answer 1

Я полагаю, что проблема здесь:

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

Вы хотите создать подкаталог, а сам подкаталог даже не существует.

Попробуйте выполнить следующее:

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