Hardcoding VBA SaveAs Path? - vba

Question

I found some VBA code online and have made modifications for what I need. I've run into the one issue of being able to change the path. I was under the impression that:
CurrentFile = ThisWorkbook.FullName
Would call back the full file name including the path to where it is currently saved, but when I run the code it goes to my /Documents (not where the file are saved). Is there a way I can modify the below with a hardcoded path?
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 code here

Answer 1

Just a minor tweak or 2 to your code will fix you. I commented your old code so you can see what I changed. You don't want to specify the file format when saving like you were doing as it will always prompt you about compatibility issues with changing the version if you are doing so. Leave it blank and it will just default to the version the sheet is already in. You can edit the C:\ after NewFile= to be whatever you need, just keep it in the quotes.
Alternately, you could change the default save location for excel, though that isn't a VBA fix.
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

when I run the code it goes to my /Documents (not where the file are saved)
This is because you've not provided a fully-qualified (full path) to the file, you've just given a Name, so it's opening the dialog with the default location of \Documents.
I prefer the FileDialog object instead of the Application.GetSaveAsFileName method.
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