Open save as window and populate file name and file path from cell

Question

I'm trying to open the save as window and populate the file name and file path from a cell

Here's the code I have which does populate the file name and opens the save as window in the file path but when I click save the file never shows up in the location where it was suppose to save.

Sub Save()

'Adds formula to show file path
ActiveSheet.Range("I26") = "=LEFT(CELL(""filename"",RC),FIND(""["",CELL(""filename"",RC),1)-1)"

'Adds formula to show file name
ActiveSheet.Range("J26") = "=MID(CELL(""filename""),FIND(""["",CELL(""filename""))+1,(FIND(""]"",CELL(""filename""))-FIND(""["",CELL(""Filename""))-8))"

ActiveSheet.Calculate 'Calculate sheet

'this will remove the formula from the cell making it text only
ActiveSheet.Range("I26") = ActiveSheet.Range("I26")
ActiveSheet.Range("J26") = ActiveSheet.Range("J26")


Dim FilePath As String
Dim FileName As String
FilePath = ActiveSheet.Range("I26").Value
FileName = ActiveSheet.Range("J26").Value


Dim fPth As Object
Set fPth = Application.FileDialog(msoFileDialogSaveAs)

With fPth
    .InitialFileName = FilePath & FileName & ".xlsm"
    .Title = "Save your File"
    .InitialView = msoFileDialogViewList
    .Show
End With


End Sub

Answer 1

The file dialog doesn't actually save the file - it just prompts the user for a filename or allows the user to change a default filename. You have to get the selected filename back and save it independently something like this:

Dim fPth As Object
Set fPth = Application.FileDialog(msoFileDialogSaveAs)

With fPth
  .InitialFileName = FileName & ".xlsm"
  .Title = "Save your File"
  .InitialView = msoFileDialogViewList
  If .Show <> 0 Then
    ThisWorkbook.SaveAs FileName:=.SelectedItems(1), FileFormat:=xlWorkbookNormal
  End If
End With