vba - Excel VBA XLDialogSaveAs 函数不起作用

Question

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

但是，当我想将文件保存在 H 盘中时，SaveAs 对话框总是显示 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")