Mar 07 2022 04:05 PM - edited Mar 19 2022 04:52 PM
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!
Mar 08 2022 09:02 AM
Maybe the information in the link will help you.
Thank you for your understanding and patience
I know I don't know anything (Socrates)
Mar 08 2022 11:01 AM
Mar 08 2022 11:40 PM
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.
I know I don't know anything (Socrates)
Mar 12 2022 03:33 PM
Mar 12 2022 03:40 PM
Mar 13 2022 04:19 AM
I don't really know how I can help you either. If none of the specialists here come up with a solution suggestion, take a look here as well, maybe this "All Questions" will help you further.
Thank you for your patience and time.
I know I don't know anything (Socrates)
Mar 19 2022 05:49 PM
Solution
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
Jul 20 2022 07:46 AM - edited Jul 20 2022 07:49 AM
This fixed it for me the first time. But when I ran it again, it failed again.
I think for me, the bug has to do with OneDrive/SharePoint.
Jul 24 2022 04:01 PM - edited Jul 24 2022 04:11 PM
@SofieDittmannthanks 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.
Jul 26 2022 11:49 AM
Jul 26 2022 12:26 PM
Mar 19 2022 05:49 PM
Solution
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