Search

Hello,

I have code designed to create an archive of my main sheet (as a .xlsx) by copying the sheet > saving the copied sheet in a new workbook > doing things to the sheet within the new workbook > saving and closing new workbook then continuing the rest of my code.

Everything works as coded except when the user selects (or keeps selected) the same file location , in the SaveAs dialog, that the original file (with the running VBA) is in. It returns a "Method 'SaveAs' of object '_Workbook' failed" error.

I created an "If" check to see if the selected file location from the SaveAs dialog is the same as the file location of the original and was able to create an error handler (avoid the error), but not an error solution. I want to default to the same file location as the original, and regardless I want the user to be able to save into the same file location, especially since that is a very typical thing to do.

Line (59) with error 1004:

ActiveWorkbook.SaveAs fileName:=PathAndFile_Name, FileFormat:=xlOpenXMLWorkbook

ShiftYear (what code is in) and PleaseWait are userforms, and "Troop to Task - Tracker" is the sheet I'm copying.

Code with error:

'<PREVIOUS CODE THAT DOESN'T PERTAIN TO THE SAVEAS ISSUE>
'''Declare variables:
'General:
Dim NewGenYear As Integer, LastGenYear As Integer, year_create_counter As Integer
NewGenYear = 0: LastGenYear = 0: year_create_counter = 0
'Personnel:
Dim cell_person As Range, cell_num As Range
Dim cell_num_default As Range
'Archive:
Dim Sheet_Archive As Worksheet, ShVal As Integer
Dim ObFD As FileDialog
Dim File_Name As String
Dim PathAndFile_Name As String
Dim Shape_Clr As Shape
Dim cell_color_convert As Range
'<A WHOLE BUNCH OF OTHER CHECKS AND CODE THAT DOESN'T PERTAIN TO THE SAVEAS ISSUE>
'Set then launch SaveAs dialog:
If ShiftYear.CheckBox5.Value = True Then 'Archive <=5 year(s) data externally - Checked:
    For Each Sheet_Archive In ThisWorkbook.Sheets
    Select Case Sheet_Archive.CodeName
    Case Is = "Sheet4", "Sheet5", "Sheet6", "Sheet7"
    ShVal = Sheet_Archive.Name
    If Sheet_Archive.Range("A2").Value <> "N/A" And ShVal <> ShiftYear.Shift_3.Value Then
    File_Name = "Archive " & Sheet_Archive.Name & "_" & ThisWorkbook.Name 'Set default (suggested) File Name
    Set ObFD = Application.FileDialog(msoFileDialogSaveAs)
    With ObFD
        .Title = "Archive Year(s) - Personnel Tracker"
        .ButtonName = "A&rchive"
        .InitialFileName = ThisWorkbook.Path & "\" & File_Name 'Default file location and File Name
        .FilterIndex = 1 'File Type (.xlsx)
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .Show
        If .SelectedItems.count = 0 Then
        MsgBox "Generation and archiving canceled. No year(s) were created, shifted, or overwritten. To continue generating without archiving, uncheck the ""Archive <=5 year(s) calendar/personnel data externally before overwriting"" box then click ""Generate"" again." _
        , vbExclamation, "Year Shift & Creation - Personnel Tracker"
        '<MY CODE THAT TURNS OFF MACRO ENHANCEMENT>
        Exit Sub
        PathAndFile_Name = .SelectedItems(1)
        End If
    End With
    Application.DisplayAlerts = False
'Load year to be archived:
    Worksheets("Formula & Code Data").Range("I7").Value = Sheet_Archive.Name
    Worksheets("Formula & Code Data").Range("I13").Value = "No"
    Call Load_Year.Load_Year
'Copy Troop to Task - Tracker sheet into new workbook and format:
    PleaseWait.Label2.Caption = "Creating " & Sheet_Archive.Name & " archive file ..."
    DoEvents
    File_Name = Right(PathAndFile_Name, Len(PathAndFile_Name) - InStrRev(PathAndFile_Name, "\")) 'Update File Name to user's input
    ThisWorkbook.Sheets("Troop to Task - Tracker").Copy
    ActiveWorkbook.SaveAs fileName:=PathAndFile_Name, FileFormat:=xlOpenXMLWorkbook 'New workbook save and activate
    '<ALL MY CODE THAT CHANGES THE NEW WORKBOOK>
    Excel.Workbooks(File_Name).Activate
    Excel.Workbooks(File_Name).Close savechanges:=True 'New workbook save and close
    Application.DisplayAlerts = True
    End If
    End Select
    If (Sheet_Archive.CodeName = "Sheet4" Or Sheet_Archive.CodeName = "Sheet5" _
    Or Sheet_Archive.CodeName = "Sheet6" Or Sheet_Archive.CodeName = "Sheet7") _
    And ShVal <> ShiftYear.Shift_3.Value Then
    PleaseWait.Label2.Caption = "" & Sheet_Archive.Name & " archive file complete"
    DoEvents
    Else: PleaseWait.Label2.Caption = "Initailizing archive ..."
    DoEvents: End If
    Next Sheet_Archive
ElseIf ShiftYear.CheckBox5.Value = False Then 'Archive <=5 year(s) data externally - Unchecked:
    'Do Nothing
End If 'Archive <=5 year(s) data externally - END
'<CONTINUING CODE THAT DOESN'T PERTAIN TO THE SAVEAS ISSUE>

Code with error handler:

'<PREVIOUS CODE THAT DOESN'T PERTAIN TO THE SAVEAS ISSUE>
'''Declare variables:
'General:
Dim NewGenYear As Integer, LastGenYear As Integer, year_create_counter As Integer
NewGenYear = 0: LastGenYear = 0: year_create_counter = 0
'Personnel:
Dim cell_person As Range, cell_num As Range
Dim cell_num_default As Range
'Archive:
Dim Sheet_Archive As Worksheet, ShVal As Integer
Dim ObFD As FileDialog
Dim File_Name As String
Dim PathAndFile_Name As String
Dim Shape_Clr As Shape
Dim cell_color_convert As Range
'<A WHOLE BUNCH OF OTHER CHECKS AND CODE THAT DOESN'T PERTAIN TO THE SAVEAS ISSUE>
'Set then launch SaveAs dialog:
If ShiftYear.CheckBox5.Value = True Then 'Archive <=5 year(s) data externally - Checked:
    For Each Sheet_Archive In ThisWorkbook.Sheets
    Select Case Sheet_Archive.CodeName
    Case Is = "Sheet4", "Sheet5", "Sheet6", "Sheet7"
Archive_Error:
    ShVal = Sheet_Archive.Name
    If Sheet_Archive.Range("A2").Value <> "N/A" And ShVal <> ShiftYear.Shift_3.Value Then
    File_Name = "Archive " & Sheet_Archive.Name & "_" & ThisWorkbook.Name 'Set default (suggested) File Name
    Set ObFD = Application.FileDialog(msoFileDialogSaveAs)
    With ObFD
        .Title = "Archive Year(s) - Personnel Tracker"
        .ButtonName = "A&rchive"
        .InitialFileName = ThisWorkbook.Path & "\" & File_Name 'Default file location and File Name
        .FilterIndex = 1 'File Type (.xlsx)
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .Show
        If .SelectedItems.count = 0 Then
        MsgBox "Generation and archiving canceled. No year(s) were created, shifted, or overwritten. To continue generating without archiving, uncheck the ""Archive <=5 year(s) calendar/personnel data externally before overwriting"" box then click ""Generate"" again." _
        , vbExclamation, "Year Shift & Creation - Personnel Tracker"
        '<MY CODE THAT TURNS OFF MACRO ENHANCEMENT>
        Exit Sub
        PathAndFile_Name = .SelectedItems(1)
        End If
    End With
    Application.DisplayAlerts = False
'Load year to be archived:
    Worksheets("Formula & Code Data").Range("I7").Value = Sheet_Archive.Name
    Worksheets("Formula & Code Data").Range("I13").Value = "No"
    Call Load_Year.Load_Year
'Copy Troop to Task - Tracker sheet into new workbook and format:
    PleaseWait.Label2.Caption = "Creating " & Sheet_Archive.Name & " archive file ..."
    DoEvents
    File_Name = Right(PathAndFile_Name, Len(PathAndFile_Name) - InStrRev(PathAndFile_Name, "\")) 'Update File Name to user's input
    ThisWorkbook.Sheets("Troop to Task - Tracker").Copy
    If PathAndFile_Name = ThisWorkbook.Path & "\" & File_Name Then 'Error handler
Archive_Error_Actual:
    MsgBox "You cannot save into the same location as this Tracker, in this version. Please select a different file location." _
    , vbExclamation, "Year Shift & Creation - Personnel Tracker"
    'UPDATE MESSAGE AND FIGURE OUT WAY TO FIX RUNTIME ERROR WHEN SAVING TO SAME LOCATION AS THE TRACKER!!!
    ActiveWorkbook.Close savechanges:=False
    GoTo Archive_Error
    End If
    On Error GoTo Archive_Error_Actual
    ActiveWorkbook.SaveAs fileName:=PathAndFile_Name, FileFormat:=xlOpenXMLWorkbook 'New workbook save and activate
    '<ALL MY CODE THAT CHANGES THE NEW WORKBOOK>
    Excel.Workbooks(File_Name).Activate
    Excel.Workbooks(File_Name).Close savechanges:=True 'New workbook save and close
    Application.DisplayAlerts = True
    End If
    End Select
    If (Sheet_Archive.CodeName = "Sheet4" Or Sheet_Archive.CodeName = "Sheet5" _
    Or Sheet_Archive.CodeName = "Sheet6" Or Sheet_Archive.CodeName = "Sheet7") _
    And ShVal <> ShiftYear.Shift_3.Value Then
    PleaseWait.Label2.Caption = "" & Sheet_Archive.Name & " archive file complete"
    DoEvents
    Else: PleaseWait.Label2.Caption = "Initailizing archive ..."
    DoEvents: End If
    Next Sheet_Archive
ElseIf ShiftYear.CheckBox5.Value = False Then 'Archive <=5 year(s) data externally - Unchecked:
    'Do Nothing
End If 'Archive <=5 year(s) data externally - END
'<CONTINUING CODE THAT DOESN'T PERTAIN TO THE SAVEAS ISSUE>

Any solution to this is much appreciated!

@Kendethar

As far as I could understand, your file is equipped with a macro, so it cannot be saved in xlsx without an error message. You have to do this in xlsm to use the macro

or if you really want to save it in xlsx, turn off / save / turn on the error message.
here is a simple pattern

Sub SaveAsXlsx()
'Save the file without macros (as an .xlsx file).
Application.DisplayAlerts = False 'Error alerts off
'here with direct path specification
ActiveWorkbook.SaveAs Filename:=Environ("USERPROFILE") & "\Desktop\Testfile.xlsx", _
                       FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True ' Displays error messages
end sub

I hope that this approach leads to the cancellation of the message, I haven't tried it.
At the same time, if this does not help you, it would be an advantage to know about the Excel version, operating system and storage medium.

NikolinoDE

I know I don't know anything (Socrates)

@NikolinoDE ,
I did use Application.DisplayAlerts = False (line 47) but won't prevent the runtime error (VBA cannot execute). And, the goal is to save the new file as a .xlsx, which it does fine in every other scenario, except when the file path is the same as the master file (.xlsm). I cannot wrap my head around it.
And to respond to your specific response, I'm not saving the file the macro is ran on but rather creating a brand new .xlsx then saving that. The code is all ran from a .xlsm, which itself is not saved or changed.

@NikolinoDE

Update:

So, the variable "PathAndFile_Name" is the defined path and name/type in the SaveAs dialog. For example, is "C:\Users\MY NAME\Desktop\CUSTOM NAME.xlsx"

And, the variable "File_Name" is just the defined name/type in the SaveAs dialog. For example, "CUSTOM NAME.xlsx"

Based on most of the internet's examples, I thought the "FileName:=" was to include the full path. But, while still getting the runtime error 1004 and reading https://docs.microsoft.com/en-us/office/vba/api/excel.workbook.saveas more carefully, I tried using just "File_Name" instead of "PathAndFile_Name" in "ActiveWorkbook.SaveAs" (line 48 below).

I don't know how or why but I solved it by changing "PathAndFile_Name" to just "File_Name" , and it will no longer produce an error when saving in the same file location as the main ".xlsm" workbook and still works with other user-selected file locations .

What's weird is using the full path in "ActiveWorkbook.SaveAs FileName:=" works in every way but the same file location as the main .xlsm. But, just using the name works in any location. If someone understands why I'd love to know, but regardless am glad it works.

For anyone looking for a complete SaveAs code (using "Application.FileDialog(msoFileDialogSaveAs)"), feel free to paste this working example into your project then edit as needed:

Sub SaveAs_YourFile()
'Set then launch SaveAs dialog (YOU CAN EDIT THIS AS NEEDED):
    On Error GoTo SaveAs_Error_Handler
    Application.ScreenUpdating = False
    Dim ObFD As FileDialog
    Dim File_Name As String
    Dim PathAndFile_Name As String
    File_Name = "YOUR DEFAULT NAME" 'Set default (suggested) File Name
    Set ObFD = Application.FileDialog(msoFileDialogSaveAs)
    With ObFD
        .Title = "Save As - YOUR PROJECT NAME"
        .ButtonName = "S&ave"
        .InitialFileName = ThisWorkbook.Path & "\" & File_Name 'Default file location and File Name
        .FilterIndex = 1 'File Type (.xlsx)
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewDetails
        .Show
        If .SelectedItems.count = 0 Then
        MsgBox "Save As canceled", vbExclamation, "Save As - YOUR PROJECT NAME"
        Application.ScreenUpdating = True: Exit Sub
        PathAndFile_Name = .SelectedItems(1)
        End If
    End With
'Verify file type (YOU CAN EDIT/REMOVE THIS AS NEEDED):
    If Right(PathAndFile_Name, Len(PathAndFile_Name) - InStrRev(PathAndFile_Name, ".") + 1) <> ".xlsx" Then
    MsgBox "Note: You can only save as an ""Excel Workbook (*.xlsx)"" file type. The file type will be changed from """ _
    & Right(PathAndFile_Name, Len(PathAndFile_Name) - InStrRev(PathAndFile_Name, ".") + 1) & """ to " & """.xlsx""." _
    , vbExclamation, "Save As - YOUR PROJECT NAME"
    PathAndFile_Name = Replace(PathAndFile_Name, Right(PathAndFile_Name, Len(PathAndFile_Name) - _
    InStrRev(PathAndFile_Name, ".") + 1), ".xlsx"): End If 'Check if file type is not .xlsx
    If Right(PathAndFile_Name, Len(PathAndFile_Name) - InStrRev(PathAndFile_Name, "\")) = ".xlsx" Then
    PathAndFile_Name = Left(PathAndFile_Name, InStrRev(PathAndFile_Name, Application.PathSeparator)) _
    & Replace(File_Name, ".xlsm", ".xlsx"): End If 'Check if file name is literally just .xlsx
'Copy YOUR SHEET into new workbook then edit (YOU CAN EDIT THIS AS NEEDED):
    Application.DisplayAlerts = False
    File_Name = Right(PathAndFile_Name, Len(PathAndFile_Name) - InStrRev(PathAndFile_Name, "\")) 'Update File Name to user's input
    ThisWorkbook.Sheets("" & Sheet1.Name & "").Copy 'SPECIFY THIS AS NEEDED
    'Note: The Sheets.copy is what creates a new workbook, thus the following code to save it then work _
    with it. With this method, only one sheet copy occurs at a time with the applicable year loaded _
    beforehand. "If you don't specify either Before or After, Microsoft Excel creates a new workbook _
    that contains the copied Worksheet object." (https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.copy)
    ActiveWorkbook.SaveAs fileName:=File_Name, FileFormat:=xlOpenXMLWorkbook 'New workbook save and activate
    With Excel.Workbooks(File_Name).Sheets
    '<YOUR CODE TO EDIT THE NEW WORKBOOK SHEET HERE>
    End With
    Excel.Workbooks(File_Name).Activate
    Excel.Workbooks(File_Name).Close SaveChanges:=True 'New workbook save and close
    Application.DisplayAlerts = True
    'Note: For full name of new workbook: "ObFD.InitialFile_Name"
    'For more information about Excel file types: https://docs.microsoft.com/en-us/office/vba/api/excel.xlfileformat
    'Original Code: https://stackoverflow.com/questions/60696187/save-a-new-excel-file-to-a-user-given-path-with-filedialog-msofiledialogsaveas
'Error handler (YOU CAN EDIT THIS AS NEEDED):
If 1 = 2 Then
SaveAs_Error_Handler:
    Application.ScreenUpdating = True: Application.DisplayAlerts = True
    MsgBox "An unexpected error occurred while saving " & File_Name & "!", vbCritical, "Save As - YOUR PROJECT NAME"
    Application.ScreenUpdating = True
    MsgBox File_Name & " saved successfully.", vbInformation, "Save As - YOUR PROJECT NAME"
End If
End Sub

@SofieDittmann thanks for the hint! I am going through the same issue at the moment. It saves perfectly on the first time running the code/macro. But when I run it again, and again... error 1004.

In my code I call the saveAs, saving the sheet with a temporary file name . Then, I create e.g. 10 copies of it using command FileCopy. After that the temp file is deleted from the folder using command Kill. Next time I run the macro, it will delete those previous old 10 copies (with Kill), so new and updated files will be generated. The aim of the code is update these 10 copies so other people can use them. So saveAs uses the same temp file name to create the first file. Then the error comes on command ActiveWorkbook.SaveAs FileName:=sPath & tempFileName & ".xlsm", FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False , right before FileCopy to the new 10 copies. But if before runing the macro I change VB code to saveAs temp name2 then the macro works perfectly. The weird is that only this temp file causes error, the 10 copies are deleted and recreated again with no issue. But if I try to run macro again saving temporary file as temp name2 , the error comes again.

So... with your hint I decided to open the folder on oneDrive/sharepoint and follow it also on Windows Explorer. And there was at sharepoint the temp filename2 still alive online although it does not appeared anymore on Windows explorer folder. But ten minutes later (yes... long 10 min later!), when OneDrive synchronized with Windows and filename2 has finally desappeared online too... Guess what... Macro can be run again using that same temp filename2 with no error.

Solution I implemented is simply add a randomic and unique string on the temp file name. I used current system time for that ( randomstr = Format(Now, "HHMMSSS"). tempFileName = "tempFile" & randomstr ). File name would be for example tempFile1955012. Then if I need to run again, new temp file will have a new and unique name, so Windows will have its time to sync with OneDrive, and completely remove the last tempFileName from the folder.