Saving a File in Desired Folder Through Browsing With VBA

Question

Writing a code to save a file with a defined filename to a specific folder entered by the user. However the file is being saved in a location previous to the specified location. For example I provide file save path as "C:\Users\arorapr\Documents\PAT" but the file is saving it in the path "C:\Users\arorapr\Documents". I have written the below code.

 File_Name = Format(Now(), "DDMMYYYY") & "_" & LName & EmpIN & "_" & Range("C6").Value & "_" & Range("J3").Value & "_" & "PAT"
 Application.DisplayAlerts = False
 MsgBox "Please select the folder to save PAT"

 With Application.FileDialog(msoFileDialogFolderPicker)
 .AllowMultiSelect = False
    .Show
End With

 ActiveWorkbook.saveas Filename:=File_Name & ".xlsm", FileFormat:=52
 Application.DisplayAlerts = True

 ActiveWorkbook.Close

Answer 1

Your challenge is that you're opening a file dialog, but not using the user's choice from that in the saveas. Try something along these lines:

Sub SaveFile()

    Dim FolderName As String

    File_Name = Format(Now(), "DDMMYYYY") & "_" & LName & EmpIN & "_" & Range("C6").Value & "_" & Range("J3").Value & "_" & "PAT"
    Application.DisplayAlerts = False
    MsgBox "Please select the folder to save PAT"

    ' Pop up the folder-selection box to get the folder form the user:
    FolderName = GetFolder()

    ' If the user didn't select anything, you can't save, so tell them so:
    If FolderName = "" Then
        MsgBox "No folder was selected. Program will terminate."
        Exit Sub
    End If

    ' Create a path by combining the file and folder names:
    File_Name = FolderName & "\" & File_Name & ".xlsm"

    ActiveWorkbook.SaveAs Filename:=File_Name, FileFormat:=52
    Application.DisplayAlerts = True

    ActiveWorkbook.Close
End Sub


' A separate function to get the folder name and return it as a string
Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Hope that helps.

Answer 2

In your code, you are not saving the path of the selected folder to a variable. In the code below, the path is saved to the variable selectedFolder, which gets its value from fldr.SelectedItems(1). Then the path + "\" + YourFileName & .xlsm is saved:

Option Explicit

Sub TestMe()

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

    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .Show
        selectedFolder = .SelectedItems(1)
    End With

    ActiveWorkbook.SaveAs Filename:=selectedFolder & "\" & "YourFileName" & ".xlsm"

End Sub

Or alternatively, you may use a function, returning the folder's path from here: VBA - Folder Picker - set where to start

---

A robust funciton, that I am using to GetFolder is this one:

Option Explicit

Sub myPathForFolder()
    Debug.Print GetFolder(Environ("USERPROFILE"))
End Sub

Function GetFolder(Optional InitialLocation As String) As String

    On Error GoTo GetFolder_Error

    Dim FolderDialog        As FileDialog
    Dim SelectedFolder      As String

    If Len(InitialLocation) = 0 Then InitialLocation = ThisWorkbook.Path

    Set FolderDialog = Excel.Application.FileDialog(msoFileDialogFolderPicker)

    With FolderDialog
        .Title = "My Title For Dialog"
        .AllowMultiSelect = False
        .InitialFileName = InitialLocation
        If .Show <> -1 Then GoTo GetFolder_Error
        SelectedFolder = .SelectedItems(1)
    End With

    GetFolder = SelectedFolder

    On Error GoTo 0
    Exit Function

GetFolder_Error:

    Debug.Print "Error " & Err.Number & " (" & Err.Description & ")

End Function