Try this:
In sheet module or in userform module
Private Sub CommandButton1_Click()
Dim strFolder As String
Dim strFName As String
strFolder = "G:\Prospects\" & Range("C14").Value & "\" & "Proposals\"
strFName = strFolder & Range("C5").Value & ".xlsm"
If CheckOrCreateMultiFolders(strFolder) Then
If Len(Dir(strFName)) = 0 Then
ActiveWorkbook.SaveAs Filename:=strFName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End If
Else
MsgBox "You do not have write permission to the folder:" & vbLf & _
"'" & strFolder & "'"
End If
End Sub
And in a standard module:
Function CheckOrCreateMultiFolders(strPath As String) As Boolean
'Checks if the entire path to the (sub)folder exists.
'If not, it tries to create it.
'The function returns:
'True - when the entire path exists or has been successfully created,
'False - when creation failed (e.g. due to lack of permissions)
Dim retVal As Long
If CreateObject("Scripting.FileSystemObject").FolderExists(strPath) Then
CheckOrCreateMultiFolders = True
Else
retVal = CreateObject("Wscript.Shell").Run("cmd /c " & "md """ & strPath & """", 0, True)
CheckOrCreateMultiFolders = (retVal = 0)
End If
End Function
Artik