CODEWITHSUNDEEP
vbaexcel
user2679225
user2679225

Reputation: 159

Hardcoding VBA SaveAs Path?

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

Upvotes: 0

Views: 860

Answers (3)

David Zemens
David Zemens

Reputation: 53623

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

Upvotes: 0

BigElittles
BigElittles

Reputation: 116

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

Upvotes: 0

Rodger
Rodger

Reputation: 841

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

Upvotes: 1

Related Questions