excel vba saveasui 文件路径

Question

我创建了一个用于注册更改的模板。这些是过程中的请求和进一步的管理。我在这个模板中有一个代码，可以将文件保存为启用了 excel 宏的工作簿。这段代码的问题是我无法定义一个特定的文件夹来保存文档。在所有情况下，都会弹出另存为对话框，用户必须能够定义自己的文件名。我想为所有用户定义路径。有谁知道如何在这个宏中添加文件位置（路径）以使其工作？

    Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim FileNameVal As String
If SaveAsUI Then
    FileNameVal = Application.GetSaveAsFilename(, "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm")
    Cancel = True
    If FileNameVal = "False" Then 'User pressed cancel
        Exit Sub
    End If
    Application.EnableEvents = False
        If Right(ThisWorkbook.Name, 5) <> ".xlsm" Then
            ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        Else
            ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        End If
    Application.EnableEvents = True
End If
End Sub

提前致谢。

亲切的问候， Remco H.

Answer 1

如果你想生成一个唯一的文件名，你可以使用类似下面的函数：

Function NextFileName(basename As String) As String
    Dim followup As Integer
    Dim pathname As String
    pathname = "C:\Temp\Temp\" ' Include the trailing path separator so that we don't have to do it later
    followup = 1
    Do
        NextFileName = pathname & basename & "-" & followup & ".xlsm"
        If Dir(NextFileName) = "" Then Exit Function
        followup = followup + 1
    Loop
End Function

然后你可以从你的主代码中调用它

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim FileNameVal As String
    If SaveAsUI Then  ' <-- Exclude the IF statement if you want EVERY save to have a new follow up number
                      '     rather than just "Save As" saves
        Application.EnableEvents = False
        'Generate the filename
        FileNameVal = NextFileName(Format(Now, "yymmdd"))
        ThisWorkbook.SaveAs Filename:=FileNameVal, FileFormat:=xlOpenXMLWorkbookMacroEnabled
        'Maybe advise the user that the save has happened, and where it went to
        MsgBox "Spreadsheet saved as " & FileNameVal
        Cancel = True
        Application.EnableEvents = True
    End If
End Sub