Excel Macro to create new folder and save file

[Clanos4]

I want to create a macro that will create a new folder called "Fungicide Quotes" under my documents and will save the workbook using the cell reference d4:f4 for the file name, which are merged cells. I have tried the following but can't get it to work. Any help would be appreciated, Thanks

Sub Save_wrkbk()

Dim strFilename, strDirname, strPathname, strDefpath As String
On Error Resume Next
strDirname = "Fungicide Quotes"

strFilename = Range("d4:f4").Value
strDefpath = "C:\My Documents\"
If IsEmpty(Filename) Then Exit Sub

MkDir strDefpath & strDirname
strPathname = strDefpath & strDirname & "\" & strFilename

ActiveWorkbook.SaveAs Filename:=strPathname, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

End sub

 

[Andrew Poulsom]

You can use the Dir function to check if the path exists. It will return "" if it doesn't exist.

 

[tom_nolan]

I must be missing something.

I tried adding the Dir function but I am still getting the same error at the same place.
Here is the code from my latest attempt.

<code>
Sub Save_wrkbk()
Dim strFilename, strDirname, strPathname, strDefpath As String
strDirname = "Test_Plans"

strFilename = Range("A1").Value
strDefpath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"
If IsEmpty(strFilename) Then Exit Sub

Dir (strDirname)
MkDir strDefpath & strDirname
strPathname = strDefpath & strDirname & "\" & strFilename

ActiveWorkbook.SaveAs Filename:=strPathname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

</code>

 

[Andrew Poulsom]

More like:

If Dir(strDefpath & strDirname) = "" Then
    MkDir strDefpath & strDirname
End If

 

[tom_nolan]

I still get the same error.

 

[Andrew Poulsom]

Maybe try:

If Dir(strDefpath & strDirname, vbDirectory) = "" Then