Hardcoding VBA SaveAs Path?

Question

Я нашел код VBA онлайн и внесли изменения в то, что мне нужно. Я столкнулся с одним из вопросов о возможности изменения пути. Я был под впечатлением, что:

CurrentFile = ThisWorkbook.FullName 

бы перезвонить полное имя файла, включая путь туда, где она в настоящее время сохраняется, но когда я запускаю код он идет к моему/Documents (не там, где файл сохраняется). Есть ли способ, который я могу изменить ниже с помощью жестко заданного пути?

Sub SaveWorkbookAsNewFile() 
Dim ActSheet As Worksheet 
Dim ActBook As Workbook 
Dim CurrentFile As String 
Dim NewFileType As String 
Dim NewFile As String 
Dim NewFileName As String 

NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy") 


Application.ScreenUpdating = False ' Prevents screen refreshing. 

CurrentFile = ThisWorkbook.FullName 

NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _ 
      "Excel Files 2007 (*.xlsx), *.xlsx," & _ 
      "All files (*.*), *.*" 

NewFile = Application.GetSaveAsFilename(_ 
    InitialFileName:=NewFileName, _ 
    fileFilter:=NewFileType) 

If NewFile <> "" And NewFile <> "False" Then 
    ActiveWorkbook.SaveAs filename:=NewFile, _ 
     FileFormat:=xlNormal, _ 
     Password:="", _ 
     WriteResPassword:="", _ 
     ReadOnlyRecommended:=False, _ 
     CreateBackup:=False 

    Set ActBook = ActiveWorkbook 
    Workbooks.Open CurrentFile 
    ActBook.Close 
End If 

Application.ScreenUpdating = True 

End Sub Код здесь

Answer 1

Просто небольшая подстройка или 2 к коду исправит вас. Я прокомментировал ваш старый код, чтобы вы могли видеть, что я изменил. Вы не хотите указывать формат файла при сохранении, как вы делали, поскольку он всегда будет предлагать вам проблемы совместимости с изменением версии, если вы это делаете. Оставьте его пустым, и он по умолчанию будет по умолчанию версией, в которой находится листок. Вы можете отредактировать C: \ after NewFile =, чтобы быть тем, что вам нужно, просто сохраните его в кавычках.

В качестве альтернативы вы можете изменить местоположение сохранения по умолчанию для excel, хотя это не исправление VBA.

Option Explicit 
Sub SaveWorkbookAsNewFile() 
Dim ActSheet As Worksheet 
Dim ActBook As Workbook 
Dim CurrentFile As String 
Dim NewFileType As String 
Dim NewFile As String 
Dim NewFileName As String 

NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy") 


Application.ScreenUpdating = False ' Prevents screen refreshing. 

CurrentFile = ThisWorkbook.FullName 

'NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _ 
'   "Excel Files 2007 (*.xlsx), *.xlsx," & _ 
'   "All files (*.*), *.*" 

NewFile = "C:\" & NewFileName 

'NewFile = Application.GetSaveAsFilename(_ 
' InitialFileName:=NewFileName, _ 
' fileFilter:=NewFileType) 

If NewFile <> "" And NewFile <> "False" Then 
    ActiveWorkbook.SaveAs Filename:=NewFile, _ 
     Password:="", _ 
     WriteResPassword:="", _ 
     ReadOnlyRecommended:=False, _ 
     CreateBackup:=False 

' ActiveWorkbook.SaveAs Filename:=NewFile, _ 
'  FileFormat:=xlNormal, _ 
'  Password:="", _ 
'  WriteResPassword:="", _ 
'  ReadOnlyRecommended:=False, _ 
'  CreateBackup:=False 

    Set ActBook = ActiveWorkbook 
    Workbooks.Open CurrentFile 
    ActBook.Close 
End If 

Application.ScreenUpdating = True 

End Sub 

Answer 2

If NewFile <> "" And NewFile <> "False" Then 
actsheet.SaveAs ("C:/HardcodedLocationHere.xlsx") ' if this fails, actbook 
    FileFormat:=xlNormal, _ 
    Password:="", _ 
    WriteResPassword:="", _ 
    ReadOnlyRecommended:=False, _ 
    CreateBackup:=False 

Set ActBook = ActiveWorkbook 
Workbooks.Open CurrentFile 
ActBook.Close 

End If

Answer 3

когда я запускаю код он идет к моему/Documents (не там, где файл сохраняется)

Это потому, что вы не обеспечили полностью квалифицированный (полный путь) к файлу вы только что дали имя, поэтому он открывает диалог с положением \ Documents по умолчанию.

Я предпочитаю объект FileDialog вместо метода Application.GetSaveAsFileName.

Option Explicit 
Sub SaveWorkbookAsNewFile() 
Dim NewFile As String 
Dim NewFileName As String 
Dim fdlg as FileDialog 

NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy") 

Application.ScreenUpdating = False ' Prevents screen refreshing. 

Set fdlg = Application.FileDialog(msoFileDialogSaveAs) 
fdlg.InitialFileName = ThisWorkbook.Path & Application.PathSeparator & NewFileName 
fdlg.Show 
If fdlg.SelectedItems.Count <> 1 Then GoTo EarlyExit 
'# Gets the new file full path & name 
NewFile = fdlg.SelectedItems(1) 

ThisWorkbook.SaveCopyAs(NewFile) 
EarlyExit: 
Application.ScreenUpdating = True 
End Sub