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]

Welcome to the Board.

What error do you get and on which line? This doesn't seem to belong in your code:

If IsEmpty(Filename) Then Exit Sub

 

[Clanos4]

I am not getting an error on any line, the code appears to run, but doesn't create the folder or the file. I have the workbook and the sheets protected.

 

[Andrew Poulsom]

Maybe the code is exiting when it reaches that stray line I pointed out.

 

[Clanos4]

I removed that line of code, and it still doesn't work, I am not sure where to go next. Is there another way to get to the same result? Thanks

 

[Andrew Poulsom]

What happens if you remove?

On Error Resume Next

 

[Clanos4]

When I remove that line I get an error,

Run-time error '76': Path not found

and it highlights the line:

MkDir strDefpath & strDirname

 

[Andrew Poulsom]

Instead of:

strDefpath = "C:\My Documents\"

try:

strDefpath = CreateObject("WScript.Shell").SpecialFolders("MyDocuments") & "\"

The path to My Documents is actually something like:

C:\Documents and Settings\user\My Documents

 

[Clanos4]

Getting there the folder created and was named correctly, now I am getting a Type mismatch error

this line is highlighted

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

When I cursor over strDefpath and strDirname I get the proper responses showing but nothing over strFilename

It looks like some problem with the filename, the range d4:f4 contains text if that helps.

 

[Clanos4]

I reset the range of the merge cells to just d4 instead of the range d4:f4 and it is now giving me the proper value, but that is not transferring down to the line I sent you previously. there is no value showing for the strFilename in this line.

strPathname = strDefpath & strDirname & "\" & strFilename