vba - 使用VBA通过浏览将文件保存在所需文件夹中

Question

编写代码以将具有定义文件名的文件保存到用户输入的特定文件夹中。但是，文件保存在指定位置之前的位置。例如，我提供的文件保存路径为“C:\Users\arorapr\Documents\PAT”，但文件将其保存在路径“C:\Users\arorapr\Documents”中。我写了下面的代码。

 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

您面临的挑战是您正在打开一个文件对话框，但没有使用用户在saveas中的选择。尝试按照以下思路进行操作:

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

希望有帮助。