Question

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

 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

在您的代码中，您没有将所选文件夹的路径保存到变量中。在下面的代码中，路径将保存到变量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：

GetFolder

或者，你可以使用一个函数，从这里返回文件夹的路径： prevent automatic sort of this Object's numeric property

我用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的强大功能就是这个：

FormControl

Answer 2

您面临的挑战是打开文件对话框，但不能使用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

希望有所帮助。

通过VBA浏览将文件保存在所需文件夹中

2 个答案: