Excel宏 - 将工作表导出到csv并浏览保存目录

I have succesfully got a macro working that does what I need it to do, but I would like to do it better, and can't.

我已经成功地完成了我需要它做的宏工作，但我想做得更好，而且不能。

-- This bit works -- By clicking a button in excel, the user exports a specific sheet to a csv with a dynamic filename and it saves the csv in a pre-determined directory.

- 此位有效 - 通过单击excel中的按钮，用户将特定工作表导出到具有动态文件名的csv，并将csv保存在预定目录中。

-- Can it do this instead -- Instead of it saving to a predetermined directory, can i have the browse window show up so they can choose a directory for it to save to? I can't figure out how to do this.

- 它可以这样做 - 而不是保存到预定的目录，我可以显示浏览窗口，以便他们可以选择一个目录，以便保存到？我无法弄清楚如何做到这一点。

Here is my macro:

这是我的宏：

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

4 个解决方案

#1

As Patrick suggested, you're looking for the .FileDialog property.

正如帕特里克所说，你正在寻找.FileDialog属性。

To implement it, try this:

要实现它，请尝试以下方法：

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

#2

Excel has an inbuilt FileSave Dialog. It is called .GetSaveAsFilename. Use that.

Excel有一个内置的FileSave对话框。它被称为.GetSaveAsFilename。用那个。

Syntax

句法

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

expression.GetSaveAsFilename（InitialFilename，FileFilter，FilterIndex，Title，ButtonText）

Usage

用法

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

#3

Try This......

尝试这个......

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

Here's a script I've been using lately that I like a lot. Thought I would leave this here:

这是我最近一直在使用的剧本，我非常喜欢。以为我会留下这个：

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

#1