如何浏览保存目录？

Posted 2023-05-07

【中文标题】如何浏览保存目录？

【英文标题】：How to browse for save directory?

【发布时间】：2014-02-05 04:47:27

【问题描述】：

通过单击 Excel 中的按钮，用户将特定工作表导出为具有动态文件名的 csv，并且 csv 保存在预先确定的目录中。

用户可以通过浏览窗口选择保存到的目录，而不是保存到预定目录吗？

Sub Export()
Dim MyPath As String
Dim MyFileName As String
MyPath = "C:\importtest"

MyFileName = "MR_Update_" & Sheets("Monthly Review").Range("D3").Value & "_" & Format(Date, "ddmmyyyy")

If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

Sheets("Export Data").Copy

With ActiveWorkbook

    .SaveAs Filename:= _
      MyPath & MyFileName, _
      FileFormat:=xlCSV, _
      CreateBackup:=False

    .Close False

End With
End Sub

【问题讨论】：

开始阅读Application.FileDialog Property (Excel)，它应该会有所帮助。

【参考方案1】：

Excel 有一个内置的FileSave Dialog。它被称为.GetSaveAsFilename。使用它。

语法

expression.GetSaveAsFilename(InitialFilename, FileFilter, FilterIndex, Title, ButtonText)

用法

Dim fileSaveName As Variant

fileSaveName = Application.GetSaveAsFilename( _
                                    fileFilter:="Excel Files (*.csv), *.csv")
If fileSaveName <> False Then
    '
    '~~> Your code to save the file here
    '
End If

【参考方案2】：

正如 Patrick 建议的那样，您正在寻找 .FileDialog 属性。

要实现它，试试这个：

Sub Export()
Dim MyPath As String
Dim MyFileName As String

MyFileName = "MR_Update_" & Sheets("Monthly Review").Range("D3").Value & "_" & Format(Date, "ddmmyyyy")

If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

Sheets("Export Data").Copy

With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = "" '<~~ The start folder path for the file picker.
    If .Show <> -1 Then GoTo NextCode
    MyPath = .SelectedItems(1) & "\"
End With

NextCode:

With ActiveWorkbook
    .SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlCSV,CreateBackup:=False
    .Close False
End With
End Sub

【讨论】：

玩了之后，遇到了一个bug。它工作得很好，但是如果你再次尝试保存它，我会弹出一个说文件已经存在的弹出窗口，你想覆盖吗？如果单击是，它可以正常工作，如果单击否，它会崩溃。调试到这一行：.SaveAs Filename:=MyPath & MyFileName, FileFormat:=xlCSV, CreateBackup:=False ;有什么想法吗？

See this SO post。具体来说，我认为您正在寻找 SaveAs 方法的 ConflictResolution:=xlLocalSessionChanges 参数。

【参考方案3】：

试试这个......

Sub Export()
Dim MyPath As String
Dim MyFileName As String
MyPath = "C:\importtest"

MyFileName = "MR_Update_" & Sheets("Monthly Review").Range("D3").Value & "_" & Format(Date, "ddmmyyyy")

If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"

Sheets("Export Data").Copy

With ActiveWorkbook

    .SaveAs Filename:= _
        MyFileName, _
        FileFormat:=xlCSV, _
        CreateBackup:=False

    .Close False
End With
End Sub

【参考方案4】：

这是我最近一直在使用的一个我非常喜欢的脚本。以为我会把它留在这里：

Sub ExportCSV()

        Dim FlSv As Variant
        Dim MyFile As String
        Dim sh As Worksheet
        Dim MyFileName As String
        Dim DateString As String

        DateString = Format(Now(), "yyyy-mm-dd_hh_mm_ss_AM/PM") '<~~ uses current time from computer clock down to the second
        MyFileName = DateString & "_" & "Whatever you like"

        Set sh = Sheets("Sheet you'd like to export")
        sh.Copy
        FlSv = Application.GetSaveAsFilename(MyFileName, fileFilter:="CSV (Comma delimited) (*.csv), *.csv", Title:="Where should we save this?")

     If FlSv = False Then GoTo UserCancel Else GoTo UserOK

    UserCancel:         '<~~ this code is run if the user cancels out the file save dialog
        ActiveWorkbook.Close (False)
        MsgBox "Export canceled"
        Exit Sub

    UserOK:             '<~~ this code is run if user proceeds with saving the file (clicks the OK button)
        MyFile = FlSv
        With ActiveWorkbook
            .SaveAs (MyFile), FileFormat:=xlCSV, CreateBackup:=False
            .Close False
        End With


    End Sub