Forum Discussion

Kendethar's avatar
Kendethar
Iron Contributor
Mar 08, 2022
Solved

SOLVED - "Method 'SaveAs' of object '_Workbook' failed" (1004) when saving into same file location

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
        Else
        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
        Else
        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!

developer
excel
Formulas and Functions
Macros and VBA
  • Kendethar's avatar
    Kendethar
    Mar 20, 2022

    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
        Else
        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"
Else
    Application.ScreenUpdating = True
    MsgBox File_Name & " saved successfully.", vbInformation, "Save As - YOUR PROJECT NAME"
End If

End Sub
    • Kendethar's avatar
      Kendethar
      Iron Contributor
      Mar 08, 2022
      I used FileFormat:=51 instead of FileFormat:=xlOpenXMLWorkbook and I still get the error.
      • NikolinoDE's avatar
        NikolinoDE
        Gold Contributor
        Mar 09, 2022

        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)

Resources