Excel VBA XLDialogSaveAs関数が機能しません

Question

.xlsファイルを.xlsxファイル形式のハードコードされた場所に自動的に保存しようとしています。 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.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 

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 

最後に、あなたは正しい場所に保存されていることを確認するために、独自のダイアログボックスを作成することができます。

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