The following functions will create a new folder (the whole path in fact) on the user's desktop, if the folder if does not already exist, and will write the workbook to that folder. As you have used the user's desktop as a location (not the best place in my opinion, but no matter) I have included a standard function to determine the path of the user's Desktop. (The 64 bit part of the code I haven't tested, but it looks OK). What I haven't included is a function to check the values in the two cells for illegal filename characters, but it is a simple job to add that if your users can't be trusted to use only valid filename characters.
Option Explicit
#If Win64 Then
Public Declare PtrSafe Function SHGetSpecialFolderLocation _
Lib "shell32" (ByVal hwnd As Long, _
ByVal nFolder As Long, ppidl As Long) As Long
Public Declare PtrSafe Function SHGetPathFromIDList _
Lib "shell32" Alias "SHGetPathFromIDListA" _
(ByVal Pidl As Long, ByVal pszPath As String) As Long
Public Declare PtrSafe Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
#Else
Public Declare Function SHGetSpecialFolderLocation _
Lib "shell32" (ByVal hwnd As Long, _
ByVal nFolder As Long, ppidl As Long) As Long
Public Declare Function SHGetPathFromIDList _
Lib "shell32" Alias "SHGetPathFromIDListA" _
(ByVal Pidl As Long, ByVal pszPath As String) As Long
Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
#End If
Public Const CSIDL_DESKTOP = &H0 'Desktop
Public Const CSIDL_INTERNET = &H1 'Internet Explorer (icon on desktop)
Public Const CSIDL_PROGRAMS = &H2 'Start Menu\Programs
Public Const CSIDL_CONTROLS = &H3 'My Computer\Control Panel
Public Const CSIDL_PRINTERS = &H4 'My Computer\Printers
Public Const CSIDL_PERSONAL = &H5 'My Documents
Public Const CSIDL_FAVORITES = &H6 '<user name>\Favorites
Public Const CSIDL_STARTUP = &H7 'Start Menu\Programs\Startup
Public Const CSIDL_RECENT = &H8 '<user name>\Recent
Public Const CSIDL_SENDTO = &H9 '<user name>\SendTo
Public Const CSIDL_BITBUCKET = &HA '<desktop>\Recycle Bin
Public Const CSIDL_STARTMENU = &HB '<user name>\Start Menu
Public Const CSIDL_MYDOCUMENTS As Long = &HC
Public Const CSIDL_MYMUSIC As Long = &HD '"My Music" folder
Public Const CSIDL_MYVIDEO As Long = &HE '"My Videos" folder
Public Const CSIDL_DESKTOPDIRECTORY = &H10 '<user name>\Desktop
Public Const CSIDL_DRIVES = &H11 'My Computer
Public Const CSIDL_NETWORK = &H12 'Network Neighborhood
Public Const CSIDL_NETHOOD = &H13 '<user name>\nethood
Public Const CSIDL_FONTS = &H14 'Windows\fonts
Public Const CSIDL_TEMPLATES = &H15
Public Const CSIDL_COMMON_STARTMENU = &H16 'All Users\Start Menu
Public Const CSIDL_COMMON_PROGRAMS = &H17 'All Users\Programs
Public Const CSIDL_COMMON_STARTUP = &H18 'All Users\Startup
Public Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19 'All Users\Desktop
Public Const CSIDL_APPDATA = &H1A '<user name>\Application Data
Public Const CSIDL_PRINTHOOD = &H1B '<user name>\PrintHood
Public Const CSIDL_LOCAL_APPDATA = &H1C '<user name>\Local Settings\Application Data (non roaming)
Public Const CSIDL_ALTSTARTUP = &H1D 'non localized startup
Public Const CSIDL_COMMON_ALTSTARTUP = &H1E 'non localized common startup
Public Const CSIDL_COMMON_FAVORITES = &H1F
Public Const CSIDL_INTERNET_CACHE = &H20
Public Const CSIDL_COOKIES = &H21
Public Const CSIDL_HISTORY = &H22
Public Const CSIDL_COMMON_APPDATA = &H23 'All Users\Application Data
Public Const CSIDL_WINDOWS = &H24 'Windows Directory
Public Const CSIDL_SYSTEM = &H25 'System Directory
Public Const CSIDL_PROGRAM_FILES = &H26 'C:\Program Files
Public Const CSIDL_MYPICTURES = &H27 'C:\Program Files\My Pictures
Public Const CSIDL_PROFILE = &H28 'USERPROFILE
Public Const CSIDL_SYSTEMX86 = &H29 'x86 system directory on RISC
Public Const CSIDL_PROGRAM_FILESX86 = &H2A 'x86 C:\Program Files on RISC
Public Const CSIDL_PROGRAM_FILES_COMMON = &H2B 'C:\Program Files\Common
Public Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C 'x86 Program Files\Common on RISC
Public Const CSIDL_COMMON_TEMPLATES = &H2D 'All Users\Templates
Public Const CSIDL_COMMON_DOCUMENTS = &H2E 'All Users\Documents
Public Const CSIDL_COMMON_ADMINTOOLS = &H2F 'All Users\Start Menu\Programs\Administrative Tools
Public Const CSIDL_ADMINTOOLS = &H30 '<user name>\Start Menu\Programs\Administrative Tools
Public Const CSIDL_CONNECTIONS = &H31 'Network and Dial-up Connections
Public Const CSIDL_COMMON_MUSIC As Long = &H35 'All Users\My Music
Public Const CSIDL_COMMON_PICTURES As Long = &H36 'All Users\My Pictures
Public Const CSIDL_COMMON_VIDEO As Long = &H37 'All Users\My Video
Public Const CSIDL_RESOURCES As Long = &H38 'Resource Directory
Public Const CSIDL_RESOURCES_LOCALIZED As Long = &H39 'Localized Resource Directory
Public Const CSIDL_COMMON_OEM_LINKS As Long = &H3A 'Links to All Users OEM specific apps
Public Const CSIDL_CDBURN_AREA As Long = &H3B 'USERPROFILE\Local Settings\Application Data\Microsoft\CD Burning
'unused As Long = &H3C
Public Const CSIDL_COMPUTERSNEARME As Long = &H3D 'Computers Near Me (computered from Workgroup membership)
Public Const MAX_PATH = 260
Public Const NOERROR = 0
Public Sub SaveWorkBook()
Dim strFilename As String, strDirname As String
Dim strPathname As String, strDefpath As String
strDefpath = SpecFolder(&H0) 'Default path name
If Range("B9").Value = "" Then
MsgBox "There is no value for the folder?"
Exit Sub
End If
If Range("B11").Value = "" Then
MsgBox "There is no value for the filename?"
Exit Sub
End If
strDirname = Trim(Range("B9").Value) ' New directory name
strFilename = Trim(Range("B11").Value) 'New file name
strPathname = strDefpath & "\" & strDirname 'Create the full path
CreateFolders strPathname
strFilename = strPathname & strFilename 'create total string
MsgBox strFilename
ActiveWorkbook.SaveAs Filename:=strFilename, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
lbl_Exit:
Exit Sub
End Sub
Public Function SpecFolder(ByVal lngFolder As Long) As String
Dim lngPidlFound As Long
Dim lngFolderFound As Long
Dim lngPidl As Long
Dim strPath As String
strPath = Space(MAX_PATH)
lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
If lngPidlFound = NOERROR Then
lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
If lngFolderFound Then
SpecFolder = Left$(strPath, _
InStr(1, strPath, vbNullChar) - 1)
End If
End If
CoTaskMemFree lngPidl
lbl_Exit:
Exit Function
End Function
Public Function CreateFolders(strPath As String)
Dim strTempPath As String
Dim lngPath As Long
Dim vPath As Variant
vPath = Split(strPath, "\")
strPath = vPath(0) & "\"
For lngPath = 1 To UBound(vPath)
strPath = strPath & vPath(lngPath) & "\"
If Not FolderExists(strPath) Then MkDir strPath
Next lngPath
lbl_Exit:
Exit Function
End Function
Public Function FolderExists(ByVal PathName As String) As Boolean
Dim lngAttr As Long
On Error GoTo NoFolder
lngAttr = GetAttr(PathName)
If (lngAttr And vbDirectory) = vbDirectory Then
FolderExists = True
End If
NoFolder:
Exit Function
End Function