如何更改Excel的默认“另存为”目录路径？

Question

嗨我只是将此代码嵌入到我的vba宏，但如何更改默认目录，当我使用此宏..例如，当我点击它将要D：/ myfolder

我发现这个代码在谷歌：

Sub Copy_ActiveSheet_2() 
'Working in Excel 2000-2013 
Dim fname As Variant 
Dim NewWb As Workbook 
Dim FileFormatValue As Long 

'Check the Excel version 
If Val(Application.Version) < 9 Then Exit Sub 
If Val(Application.Version) < 12 Then 

    'Only choice in the "Save as type" dropdown is Excel files(xls) 
    'because the Excel version is 2000-2003 
    fname = Application.GetSaveAsFilename(InitialFileName:="", _ 
    filefilter:="Excel Files (*.xls), *.xls", _ 
    Title:="This example copies the ActiveSheet to a new workbook") 

    If fname <> False Then 
     'Copy the ActiveSheet to new workbook 
     ActiveSheet.Copy 
     Set NewWb = ActiveWorkbook 

     'We use the 2000-2003 format xlWorkbookNormal here to save as xls 
     NewWb.SaveAs fname, FileFormat:=-4143, CreateBackup:=False 
     NewWb.Close False 
     Set NewWb = Nothing 

    End If 
Else 
    'Give the user the choice to save in 2000-2003 format or in one of the 
    'new formats. Use the "Save as type" dropdown to make a choice,Default = 
    'Excel Macro Enabled Workbook. You can add or remove formats to/from the list 

    fname = Application.GetSaveAsFilename(InitialFileName:="", filefilter:= _ 
     " Excel Macro Free Workbook (*.xlsx), *.xlsx," & _ 
     " Excel Macro Enabled Workbook (*.xlsm), *.xlsm," & _ 
     " Excel 2000-2003 Workbook (*.xls), *.xls," & _ 
     " Excel Binary Workbook (*.xlsb), *.xlsb", _ 
     FilterIndex:=2, Title:="This example copies the ActiveSheet to a new workbook") 

    'Find the correct FileFormat that match the choice in the "Save as type" list 
    If fname <> False Then 
     Select Case LCase(Right(fname, Len(fname) - InStrRev(fname, ".", , 1))) 
     Case "xls": FileFormatValue = 56 
     Case "xlsx": FileFormatValue = 51 
     Case "xlsm": FileFormatValue = 52 
     Case "xlsb": FileFormatValue = 50 
     Case Else: FileFormatValue = 0 
     End Select 

     'Now we can create/Save the file with the xlFileFormat parameter 
     'value that match the file extension 
     If FileFormatValue = 0 Then 
      MsgBox "Sorry, unknown file extension" 
     Else 
      'Copies the ActiveSheet to new workbook 
      ActiveSheet.Copy 
      Set NewWb = ActiveWorkbook 

      'Save the file in the format you choose in the "Save as type" dropdown 
      NewWb.SaveAs fname, FileFormat:= _ 
         FileFormatValue, CreateBackup:=False 
      NewWb.Close False 
      Set NewWb = Nothing 

     End If 
    End If 
End If 
End Sub 

Answer 1

更改这部分代码

fname = Application.GetSaveAsFilename(InitialFileName:="" 

包括默认保存路径，你想

fname = Application.GetSaveAsFilename(InitialFileName:=""C:\My Documents\" 

请确保您保留尾部反斜杠，否则会建议一个默认文件，其文件名与您提供的路径相同，例如。

fname = Application.GetSaveAsFilename(InitialFileName:=""C:\My Documents" 

会导致在“我的文档”保存在位置的名为默认文件对话框“C：\”