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