msoFileDialogFolderPicker macro operates unexpectedly

[astepawayfromx]

The Macro below is supposed to copy a a tab, open a dialog box prompting me to select a folder, and to save the new file with read only recommended and marked as final using the filename in cell I4. It mostly works, but when I select a folder, it always saves in that folder's parent folder. So if my directory is Customer>A>Autozone and I select Autozone, it saves in A. I cannot for the life of me figure out why it is doing this and any help you can provide would be hugely appreciated.

Sub Adjust_and_Save()'
' Adjust_and_Save Macro
'






Dim ThisFile As String
InitialFileName = Range("I4").Value


ActiveSheet.Select
ActiveSheet.Copy




   Dim fldr As FileDialog
    Dim sPath As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)


    With fldr
        .Title = "Select folder"
        .AllowMultiSelect = False
        If .Show = -1 Then
            sPath = .SelectedItems(1)
        End If
    End With






    ActiveWorkbook.SaveAs Filename:=InitialFileName & ".xlsx", Password:="", WriteResPassword:="", ReadOnlyRecommended:=True, CreateBackup:=False
ActiveWorkbook.Final = True
Application.DisplayAlerts = True






ActiveWorkbook.Close






 End Sub

 

[vaskov17]

Seems like you are not adding the sPath when you are saving the file. Try changing the SaveAs part of the code to Filename:=sPath & "\" & InitialFileName & ".xlsx". Not sure if you need the slash or not.