Excel VBA XLDialogSaveAs函数不能正常工作

我正试图自动将.xls文件保存在.xlsx文件格式的硬编码位置。 我希望SaveAs对话框显示硬编码的位置，以及在“File Name：”字段中编码的文件名。 这是我所需要做的是点击保存button。

但是，当我想将文件保存在H Drive中时，SaveAs对话框总是显示C Drive。

以下是我的代码：

Option Explicit Sub externalRatingChangeFile() 'Declare the data type of the variables Dim wks As Worksheet Dim sFilename As String 'Set wks to the current active worksheet Set wks = ActiveWorkbook.ActiveSheet 'Set the location to save the file to a variable sFilename = "H:\testing file" 'Save as .xlsx file in the specific location stated earlier 'If there are errors in the code, set wks to nothing and end the process On Error GoTo err_handler ChDrive sFilename ChDir sFilename Application.Dialogs(xlDialogSaveAs).Show (sFilename & "\TestingFile - " & Format(Date, "YYYYMMDD") & ".xlsx") 'System to/not display alerts to notify Users that they are replacing an existing file. Application.DisplayAlerts = True err_handler: 'Set Wks to its default value Set wks = Nothing End Sub 

Answer 1

虽然我更喜欢Application.GetSaveAsFilename方法 （请参阅此 ），但在xlDialogSaveAs上设置初始文件夹应该没有问题，前提条件是以前没有保存原始工作簿。

 Sub externalRatingChangeFile() Dim bSaved As Boolean Dim xlsxFileFormat As XlFileFormat 'Declare the data type of the variables Dim wks As Worksheet Dim sFilename As String 'Set wks to the current active worksheet Set wks = ActiveWorkbook.ActiveSheet 'Set the location to save the file to a variable sFilename = "H:\testing file" xlsxFileFormat = XlFileFormat.xlOpenXMLWorkbook 'Save as .xlsx file in the specific location stated earlier On Error GoTo err_handler bSaved = Application.Dialogs(xlDialogSaveAs).Show(Arg1:=sFilename & "\TestingFile - " & Format(Date, "YYYYMMDD"), _ arg2:=xlsxFileFormat) 'System to/not display alerts to notify Users that they are replacing an existing file. Application.DisplayAlerts = True err_handler: 'Set Wks to its default value Set wks = Nothing End Sub 

Answer 2

而不是显示另存为对话框，直接保存到该文件夹​​。

  Application.DisplayAlerts = False wks.SaveAs (sFilename + "\TestingFile - " + Format(Date, "YYYYMMDD") + ".xlsx") Application.DisplayAlerts = True 

要么

  Application.DisplayAlerts = False wks.SaveCopyAs (sFilename + "\TestingFile - " + Format(Date, "YYYYMMDD") + ".xlsx") Application.DisplayAlerts = True 

最后，你可以创build自己的对话框，以确保你保存在正确的位置：

 'Result = 2 is Cancel 'Result = 1 is Ok result = MsgBox("Would You Like To Save in the Following Location: " + "H:\Test File....", vbOKCancel, "Save As")