通过使用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

希望这能有所帮助。

Answer 2

在您的代码中，您不会将选定文件夹的路径保存到变量。在下面的代码中，路径被保存到变量selectedFolder，该变量从fldr.SelectedItems(1)获取其值。然后保存path + "\" + YourFileName & .xlsm：

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

或者，您也可以使用一个函数，从这里返回文件夹的路径：VBA - Folder Picker - set where to start

我用来使用GetFolder的一个健壮的函数是：

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