I've searched through several forums and have found similar questions, but not my specific problem.
I have a macro that saves the active workbook to the specific user's folder, and saves a dated, xlsx, version in a sub folder. My macro-enable workbook is used by both in-office and remote associates. The in-office associates have no issue using this macro to save & archive the workbook to their folder, and, up until last week, the remote associates using VPN had no issues either.
However, over the past few days the remote associates using VPN have been receiving an error like run time error '1004': The specified dimensions are not valid for the current chart type and the code hangs on the ActiveWorkbook.SaveAs line at the end. Why would this error be coming up for a .SaveAs issue? I'm at a loss.
MainPath = "O:\Revenue Management\Centralized Revenue Management Service\CRMS Hotels\"
sPathSeek = MainPath & strPropNo & "*"
sFile = Dir(sPathSeek, vbDirectory)
sFileCheck = MainPath & sFile & "\Strategy Pack"
sBuildHist = MainPath & sFile & "\Strategy Pack\" & year1 & "\"
filePath = MainPath & sFile & "\Strategy Pack\" & propNo & " Strategy Pack.xlsm"
histPath = MainPath & sFile & "\Strategy Pack\" & year1 & "\" & propNo & " Strategy Pack " & STRdate & ".xlsx"
iLength = Len(Dir(sFileCheck, vbDirectory))
iLength2 = Len(Dir(sBuildHist, vbDirectory))
If iLength = 0 Then
MkDir (sFileCheck)
End If
If iLength2 = 0 Then
MkDir (sBuildHist)
End If
'Save Master Workbook
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=filePath,
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
The file I am trying to save over is also a .xlsm file.
I've tried removing all charts.
I've tried re-saving the master file.
It's worth noting that the same day this started happening, my VPN access would not log in until our systems administrator unlocked it (which was a first)
I have
error 53 'file not found'
Here is the most streamlined version of the script:
Sub Test()
Dim NJ As String, path As String, Oud As String, Archief As String, Nieuw As String
path = "C:\Test" & "\"
Oud = path & "A"
Archief = path & ("Archive") & "\" & "A"
Nieuw = path & "B"
Application.Workbooks.Add
ActiveWorkbook.SaveAs Oud
ActiveWorkbook.SaveAs Archief
ActiveWorkbook.SaveAs Nieuw
Kill Oud
End Sub
I tried to bypass the possibility of a too-long pathname by limiting it to its bare essentials.
I created a new file, which I gave a variable name to make sure no mistakes were made in the pathname.
I spoke with IT to make sure I have proper permissions to change, edit and delete files.
The script does not make a lot of sense, (why not just create Archief and Nieuw?), but I am trying to understand the error that occurs in another script in which I try to archive some files (say, "name 2017") in an archive folder, rename them for the new year in the original file (e.g. "name 2018") and then kill the original 2017 files to clean up the mess.
It does not make sense that the file I just created cannot be found.
Please do the below changes:
1) add these lines to your Code:
Dim filename As String
filename = "test.xls" 'You can select any name and any excel file format
2) Replace these lines:
Application.Workbooks.Add
ActiveWorkbook.SaveAs Oud
ActiveWorkbook.SaveAs Archief
ActiveWorkbook.SaveAs Nieuw
Kill Oud
With these:
ActiveWorkbook.SaveAs Oud & "\" & filename
ActiveWorkbook.SaveAs Archief & "\" & filename
ActiveWorkbook.SaveAs Nieuw & "\" & filename
Kill Oud & "\" & filename
Background:
Several years ago, I made a spreadsheet to generate a list of samples to be tested each day. The user (usually me) checks boxes to indicate which tests' samples to list. Then the "save load sheet" button uses VBA to requery a database connection for sample information, populates the formatted list through a complex series of formulas, copies the values from the formula sheet ("Generator") to another sheet ("LoadSheet"), copies that sheet to a new workbook, and saves it with the date as filename in a folder according to year and month.
It worked pretty dependably for about 5 years, right up until a couple of weeks ago when my computer was upgraded from Windows 7 with Office 2013 to Windows 10 with Office 2016.
Problem:
Now, when I try to execute the code, I get Runtime error '1004: Copy method of Worksheet class failed."
Sub SaveAs()
'Copy to new workbook.
Sheets("LoadSheet").Copy '<---This is the line that fails.
' Check directory, create if necessary.
If Dir("G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\", vbDirectory) = "" Then
If Dir("G:\Load Sheets\" & Year(Now) & "\", vbDirectory) = "" Then
MkDir ("G:\Load Sheets\" & Year(Now) & "\")
End If
MkDir ("G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\")
End If
'Save.
'If the worksheet already exists, the user will be asked whether to replace the file or not.
'If it already exists and is currently open, an error could arise.
'Hopefully that won't come up before I have time to think of a way to implement error handling.
ActiveWorkbook.SaveAs Filename:= _
"G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\" & Format(Now, "mm-dd-yy") & "x", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Range("A1").Select
Sheets(1).Select
Range("A1").Select
ActiveWorkbook.Save
Application.CutCopyMode = False
ThisWorkbook.Activate
Workbooks(Format(Now, "mm-dd-yy") & "x.xlsx").Activate
End Sub
This is the code that saves the file. It fails on the line indicated.
What I've already tried:
I've tried right-clicking on the worksheet tab, clicking "Move or Copy..." and try to create a copy in a new workbook. Nothing happens. No error message, no new worksheet/book, nothing.
Same thing happens if I try to "move" rather than "copy."
If I try right-clicking and creating a copy in the same workbook, I get a new blank sheet, rather than a copy.
I tried repairing my Office installation, but that didn't help.
I read about some cases where users suspected file corruption, so I even tried manually copying the contents to a new workbook by Ctrl+A,C,V one sheet at a time, and then doing the same for the code. No effect.
I tried Sheets(Worksheets.Count).Select followed by ActiveSheet.Copy, since the sheet is the last one in the book, but of course that didn't work.
I read that it could be because the workbook needed to be saved first, so I tried ActiveWorkbook.Save before the copy. Still the same result.
I tried decompiling/recompiling the worksheet to no effect.
It worked fine on Windows 7 with Office 2013 (and still does on a co-worker's Win7/Excel2013 machine), but I couldn't find anything online about problems with the Sheets.Copy method in Excel 2016, so I don't know if either of those is relevant.
Any ideas?
EDIT: I've tried it on an identical computer (also running Windows 10 & Office 2016) and had the same result. I'm not sure how commonly an installation becomes corrupted, but this feels like more than coincidence. The other computer is rarely used by anyone, and it's being used primarily to run an instance of SQL Server Express and a Windows service I wrote, so I suspect that makes corruption even less likely.
I've got a workaround for now... I just save the file with the filename and path I would have used for the copy, then do a For Each on each worksheet, deleting anything not named "LoadSheet."
Sub SaveAs()
On Error GoTo SaveAs_Err
'Check directory, create if necessary.
If Dir("G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\", vbDirectory) = "" Then '<> "G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\" Then
If Dir("G:\Load Sheets\" & Year(Now) & "\", vbDirectory) = "" Then '<> "G:\Load Sheets\" & Year(Now) & "\" Then
MkDir ("G:\Load Sheets\" & Year(Now) & "\")
End If
MkDir ("G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\")
End If
' Turn off alerts. They're annoying. I don't care if it's poor form, I just want to be done with this. I'm not being paid to write code.
Application.DisplayAlerts = False
'Save, disregarding consequences.
ActiveWorkbook.SaveAs Filename:= _
"G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\" & Format(Now, "mm-dd-yy") & "x", _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
' Remove extraneous sheets.
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
If ws.Name <> "LoadSheet" Then ws.Delete
Next
Application.DisplayAlerts = True
Exit Sub
SaveAs_Err:
Application.DisplayAlerts = True
MsgBox ("An error occurred while saving the file.")
Debug.Print "Error " & Err.Number & ": " & Err.Description
End Sub
I'm still interested in fixing the root cause of this problem, so if anyone has ideas, I'm all ears! I'll probably still try the uninstall/reinstall, but I don't expect it to change anything.
Brute force fix, try:
Sub SaveAs()
Dim newWB as Workbook, i as Integer, copyRange as Range, fName as String
Set newWB = Workbooks.Add
While newWB.Worksheets.Count > 1
newWB.Worksheets(newWB.Worksheets.Count).Delete
Wend
newWB.Worksheets(1).Name = "LoadSheet"
' get a handle on the sheet's usedRange object
Set copyRange = ThisWorkbook.Worksheets("LoadSheet").UsedRange
' assign the values to the newWB.Worksheets(1)
'newWB.Worksheets(1).Range(copyRange.Address).Value = copyRange.Value
copyRange.Copy Destination:=newWB.Worksheets(1).Range(copyRange.Address)
'Check directory, create if necessary.
If Dir("G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\", vbDirectory) = "" Then
If Dir("G:\Load Sheets\" & Year(Now) & "\", vbDirectory) = "" Then
MkDir ("G:\Load Sheets\" & Year(Now) & "\")
End If
MkDir ("G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\")
End If
fName = "G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\" & Format(Now, "mm-dd-yy") & "x"
If Dir(fName & ".xlsx") <> "" Then Kill fName & ".xlsx"
If Dir(fName & ".xlsm") <> "" Then Kill fName & ".xlsm"
newWB.SaveAs Filename:= fName, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Workbooks.Open(fName)
End Sub
Alternatively, use the SaveAs method of the Worksheets class:
Sub SaveAs()
Dim fName as String
'Check directory, create if necessary.
If Dir("G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\", vbDirectory) = "" Then
If Dir("G:\Load Sheets\" & Year(Now) & "\", vbDirectory) = "" Then
MkDir ("G:\Load Sheets\" & Year(Now) & "\")
End If
MkDir ("G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\")
End If
fName = "G:\Load Sheets\" & Year(Now) & "\" & MonthName(Month(Now)) & "\" & Format(Now, "mm-dd-yy") & "x"
If Dir(fName & ".xlsx") <> "" Then Kill fName & ".xlsx"
If Dir(fName & ".xlsm") <> "" Then Kill fName & ".xlsm"
ThisWorkbook.Worksheets("LoadSheet").SaveAs Filename:= fName, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Save
Application.CutCopyMode = False
Workbooks.Open(fName)
End Sub
I've also revised both solutions to avoid the potential error you comment:
If it already exists and is currently open, an error could arise.
I would work with your IT and/or MS support on the specific failure of the .Copy method, though, it's almost certainly a problem with your installation and may result in nastier errors in the future.
I am currently having an error with a vba script, tried to fix it but still gives an error as listed in the title.
The aim of the script is to copy file names based on an input form a worksheet and then copy them to a destination saving them with the current date in the name.
Set FSO = CreateObject("scripting.filesystemobject")
FILE = Sheet1.Range("G3").Value
FILE2 = Sheet1.Range("G4").Value
SourceFile = Source & "\" & FILE & ".xls"
DestFile = DestPath & "\" & FILE & " " & ShortDate & ".csv"
SourceFile2 = Source & "\" & FILE2 & ".xls"
DestFile2 = DestPath & "\" & FILE2 & " " & ShortDate & ".csv"
'Setsup Flag File
Dim oFile As Object
Set oFile = FSO.CreateTextFile(DestPath & "\OIS.FLAG")
oFile.WriteLine Format(Sheets("Sheet1").Range("C7").Value, "yyyy/mm/dd")
oFile.Close
FSO.CopyFile SourceFile, DestFile
FSO.CopyFile SourceFile2, DestFile2
Source is just set to "C:\Users\Data"
DestPath is just "C:\Users\updates"
When I run the script the first copy works, so SourceFile is copied, but then the runtime error occurs for the second one SourceFile2, but I've checked multiple times and the SourceFile2 Exists...
Any Tips, or something I'm missing? Also Checked other similar threads, and it's not because the string is too long?
If I input the whole name for SourceFile2 i.e "C:\Users\Data\file2.xls" then it works but I've checked the syntax a million times and seems to be fine, maybe a fresh pair of eyes will help, any suggestions would be massively appreciated :)
I have a backup macro that runs every time when I save my excel file and saves a copy of the workbook into a folder.
Now I got a new computer where I use the same file, and it does not work anymore, I get run-time error 1004.
My co worker uses the same excel file and the same computer with another user and for him the macro works perfectly as it used to work for me on the other computer.
Code:
'backup
ora = ".h" & Hour(Now)
bufolder = ThisWorkbook.Path & "\excel_backups"
If Len(Dir(bufolder, vbDirectory)) = 0 Then
MkDir bufolder
End If
excfile = ThisWorkbook.Path & "\excel_backups\backup_" & Format(Date, "yyyy/mm/dd") & ora & "_" & ActiveWorkbook.name
If Dir(excfile) = "" Then
ActiveWorkbook.SaveCopyAs Filename:=bufolder & "\backup_" & Format(Date, "yyyy/mm/dd") & ora & "_" & ActiveWorkbook.name
End If
Edit: I get the error on line:
ActiveWorkbook.SaveCopyAs Filename:=bufolder & "\backup_" & Format(Date, "yyyy/mm/dd") & ora & "_" & ActiveWorkbook.name
It says:
Microsoft Office Excel cannot access the file '...'
There are several
possible reasons:
The file name of path does not exit. The file is being used by another
program. The Workbook you are trying to save has the same name as a
I don't think any of these problems may cause the problem.
Thank you for your time
The file cannot be saved because you are attempting to save the file name with your date formatted as "yyyy/mm/dd"? My computer will not allow me to save a file name with backslashes in it. Try changing the Format function to Format(Date, "yyyy-mm-dd").