Excel VBA XLDialogSaveAs 函数不起作用

Question

我正在尝试以 .xlsx 文件格式自动将 .xls 文件保存在硬编码位置。我希望 SaveAs 对话框显示硬编码的位置，以及在“文件名：”字段中编码的文件名。因此，我需要做的就是单击“保存”按钮。

但是，当我想将文件保存在 H 盘中时，“另存为”对话框总是显示 C 盘。

以下是我的代码：

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.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

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

'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")

Answer 2

虽然我更喜欢Application.GetSaveAsFilename method（请参阅this），但如果之前未保存原始工作簿，则在 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