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

Posted 2023-05-06

【中文标题】通过使用 VBA 浏览将文件保存在所需文件夹中

【英文标题】：Saving a File in Desired Folder Through Browsing With VBA

【发布时间】：2018-05-24 12:32:54

【问题描述】：

编写代码以将具有已定义文件名的文件保存到用户输入的特定文件夹中。但是，文件被保存在指定位置之前的位置。例如，我将文件保存路径提供为“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

【参考方案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

希望对您有所帮助。

【参考方案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

【讨论】：

您可以使用If .SelectedItems.Count > 0 ... 之类的内容来诱捕用户在此处单击“取消”

@CLR - 是的。然后我可以放置错误处理程序和初始位置。一般来说，我在考虑是否从这里给出整个函数 - github.com/Vitosh/VBA_personal/blob/master/… - 但我决定参考 SO 问题。

@perna arora - 欢迎您。总的来说，看一下here和here这两个函数，它们可以为你省去一些问题，而且非常健壮。