I have written this VBA code to save a new version of a file in a specified location. It works absolutely fine on my computer but won't work on a colleagues. We are both using the same version of Excel. I have made sure there are no passwords in the workbook and also made sure he has full permissions on the file.
Sub SaveNew()
Dim FileName As String
Dim Path As String
Dim Plnt As String
Dim PC As String
Dim fso As FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject")
'Save and calculate workbook before changes. Patse Filename so it doesnt change
ActiveWorkbook.Save
ActiveSheet.Calculate
ActiveSheet.Select
Range("c7").Copy
Range("c8").PasteSpecial xlPasteValues
'Define path and filename
Path = "Z:\UK\BFD\MAReports$\PPV & MR21\Stock Loss\Site Files\"
FileName = Sheets("Menu").Range("c8")
Plnt = Sheets("Menu").Range("c3")
PC = Sheets("Menu").Range("c5")
'Save new version
ThisWorkbook.SaveAs FileName:=Path & FileName & ".xlsm", FileFormat:=52
Any help appreciated!
There's a couple of things that are odd about this code, see comments to the right:
ActiveWorkbook.Save 'saves the current book (that's ok)
ActiveSheet.Calculate 'only meaningful if you have calculation set to manual
ActiveSheet.Select 'why select the activesheet, you're not using the selection
Range("c7").Copy 'why copy/paste c7 to c8? if c7 is empty the saveAs fails
Range("c8").PasteSpecial xlPasteValues 'this is better: Range("c8").Value = Range("c7").Value
And probably the problem you have is either caused by:
1- SaveAs does not save a copy but saves the current workbook under a new name so if another user on another computer runs the same macro and Z: is a shared drive then the other user/computer will have the same file locked that you want to save to until on the other computer Excel is closed and the other user/computer and you/your computer have the same privileges on this file.
2- You/your computer has no authorization to write on that network location
I've tested your code and I can replicate cause 1 with the same 1004 runtime error
Related
If have a large Workbook with a sub, that copies a specific worksheet to a new workbook and then saves this worksheet as FileFormat51 (xlsx without macro) to get rid of the contained code:
Public Sub savefile()
Dim WB As Workbook, WBtemp As Workbook
Dim path As String, antw As String, ext As String
Dim filetobesaved
path = ThisWorkbook.path
With Application.FileDialog(msoFileDialogSaveAs)
.InitialFileName = path & "\" & "standard name"
Application.ScreenUpdating = True
antw = .Show
Application.ScreenUpdating = False
If antw = -1 Then
filetobesaved = .SelectedItems(1)
ext = Right(filetobesaved, Len(filetobesaved) - InStrRev(filetobesaved, ".")) 'InStrRev() finds the first dot from the right and gives its position to Right() to write the file extension into ext
If ext <> "xlsx" Then
MsgBox "You chose ." & ext & " as filename extension. As this might cause problems during the current procedure I will change it to .xlsx."
filetobesaved = Left(filetobesaved, InStrRev(filetobesaved, ".")) & "xlsx"
End If
Else
Exit Sub
End If
End With
Set WB = ActiveWorkbook
TKontur.Copy
Set WBtemp = ActiveWorkbook
WBtemp.SaveAs Filename:=filetobesaved, FileFormat:=51 '51 = .xlsx without macros
WBtemp.Close
End Sub
This worked well for years until Excel started compiling the code right after the Worksheet got copied.
The code of the workbook compiles well before the copy-task (debug->Compile VBAProject works fine) but after the copy-statement the code fails to compile for many reasons that all include that the worksheet got copied into a new workbook without all the other worksheets and modules it references.
Currently if I restart the PC and then open the workbook and only execute the given sub, then I get said error.
The weird thing is at first I thought it was a data corruption error and rebuilt the whole thing (and rebuilt it again multiple times until now) and after every rebuild everything works fine for at least one time but eventually the same bug reappears and I have no clue what causes it to reappear.
I also found out that deleting any module (no matter which one), saving the Workbook and then reopening the workbook causes the error to not occur at least one time (-> all fine) no matter which module I delete.
So I thought it might be a problem with memory overflow.
But then when I rewrote the program with the most basic functions but half the code and half the modules this worked fine for two weeks and then the error reappeared.
It gets weirder: I wrote a more basic version with version number say 2.0
In those two weeks I changed some things to version 2.5
Most versions were in use at some time and worked.
But when the error occured in version 2.5 once all versions back to 2.0 started to have the same error right away when they did not have it before.
Also if the error occured at least one time, then no matter what I change it will occure every time except if I remove every single one of the many references to things in other modules and worksheets than the copied one.
There's also a very similar error that happens to be kind of unrelated (either error can happen without the other error and sometimes they happen both and sometimes neither happens) but has very similar properties:
When closing the workbook sometimes excel closes the excel-objects first and then compiles the modules and fails with that.
When that happens, then
ThisWorkbook.Saved = True
ActiveWorkbook.Close
usually helps to ignore that error for a while, but then (usually after a year or so) it reappears even with those two lines. Edit: Also this workaround seems to have a 20% chance to crash Excel including all other open workbooks.
Last thing: As soon as the error occurs once
most of the time it then occurs on all PCs and Notebooks including different update status, Operating System and Office version.
I disabled events (Application.EnableEvents = False) before saving the workbook as a workaround. It worked for me!
Also, as I prefer to use the Excel constants name for better readability instead of Excel constant values. For eg. below are the main formats, I use xlOpenXMLWorkbook for xlsx instead of just 51. Though this has nothing to do with the error you or I was getting.
51 = xlOpenXMLWorkbook (without macro's in 2007-2016, xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2016, xlsm)
50 = xlExcel12 (Excel Binary Workbook in 2007-2016 with or without macro's, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2016, xls)
Here is the modified code for reference:
Public Sub savefile()
Dim WB As Workbook, WBtemp As Workbook
Dim path As String, antw As String, ext As String
Dim filetobesaved
path = ThisWorkbook.path
With Application.FileDialog(msoFileDialogSaveAs)
.InitialFileName = path & "\" & "standard name"
Application.ScreenUpdating = True
antw = .Show
Application.ScreenUpdating = False
If antw = -1 Then
filetobesaved = .SelectedItems(1)
ext = Right(filetobesaved, Len(filetobesaved) - InStrRev(filetobesaved, ".")) 'InStrRev() finds the first dot from the right and gives its position to Right() to write the file extension into ext
If ext <> "xlsx" Then
MsgBox "You chose ." & ext & " as filename extension. As this might cause problems during the current procedure I will change it to .xlsx."
filetobesaved = Left(filetobesaved, InStrRev(filetobesaved, ".")) & "xlsx"
End If
Else
Exit Sub
End If
End With
Set WB = ActiveWorkbook
TKontur.Copy
Set WBtemp = ActiveWorkbook
Application.EnableEvents = False
WBtemp.SaveAs Filename:=filetobesaved, FileFormat:=xlOpenXMLWorkbook ' = xlsx
WBtemp.Close
Application.EnableEvents = True
End Sub
When I use vba to copy a worksheet to another workbook, one of my image picture will be broken with this error:
Dim filename as string
filename = "copyToThisExcel.xlsm"
Workbooks.Open filename:= "C:\myExcelFile.xlsm"
Sheets("Sheet1").Select
Sheets("Sheet1").Copy After:=Workbooks(filename).Sheets(1)
This happens randomly on computers and not others. I believe it is a known bug for 2007 and 2010 excel. Is there any workaround this or different alternatives to add images to excel that would not cause this issue?
Here is a link to this known bug.
http://www.spreadsheet1.com/excel-vba-bugs.html
I think you have to open the destinaion file. Look at this example :
Option Explicit
Sub test()
Dim filename As String
filename = "myFile2.xlsm"
Workbooks.Open filename:="C:\temp\myFile2.xlsm"
Workbooks.Open filename:="C:\temp\myFile1.xlsm"
Sheets("Sheet1").Copy After:=Workbooks(filename).Sheets(1)
End Sub
I have created one script which is launched on click button, so it loads CSV file from path and format and than save it. As I have files from 1...10000 so I made file like 1.txt and so on.
I am getting problem is when it start process everything goes fine but after 10-13 files it give error and excel closes. Following are codes I am using. Please assist me where I am doing mistake. I think I am doing mistake in array I tried redim but but that one gives me same error. This is sub which I placed on my button to start process. As I have more than thousands files so please suggest me solution.
Sub WorkbooksLoop()
' get the list of filenames
Dim pageStart As Integer
Dim pageEnd As Integer
pageStart = CInt(Cells(3, "C").Value) ' getting from cell of excel sheet
pageEnd = CInt(Cells(4, "C").Value) ' getting from cell of excel sheet
Dim Filenames(44) As String ' variable I know there are 44 files
For j = pageStart To pageEnd
Filenames(j) = CStr(j) + ".txt"
Next j
On Error GoTo NoFilenames
Dim controllerwb As Workbook
Set controllerwb = ActiveWorkbook
Dim wb As Workbook
Dim fname As Variant
Dim rootPath As String
rootPath = ThisWorkbook.Path
rootPath = rootPath & "\"
For Each fname In Filenames
' Make the controller active
controllerwb.Activate
On Error Resume Next
' If activate fails, then the workbook isn't open
Workbooks(fname).Activate
' If activate fails, then the workbook isn't open
If Err <> 0 Then
OpenFile (rootPath & fname)
Set wb = ActiveWorkbook
wb.Activate
' Otherwise, workbook is already open, refer to it by name
Else
OpenFile (rootPath & fname)
Set wb = ActiveWorkbook
End If
' do something to the open workbook my process to format sheet
deletingRowsColumns
ledgerSetup
resizeColumns
columnLines
columnAlignments
mergeTitles
settingNames
wb.Close
Next fname
NoFilenames:
End Sub
I have done everything and recode it in different way. But still after 10-20 files it through an error. As I was using windows machine on my mac as virtual machine, so I just thought why not i try it on mac with microsoft office. And have to change just forward slashes of directory to colon(interesting I thought it should be back slash but that is how vba was doing) and it worked I get alert of some file not saving, but it is ok at least I could do 1000 files easily rest I can save manually. But it realy work although vba engine is little bit slower in mac but who cares I just leave it for few hours to do all files for me.
Thanks for all your help. Mike yes I need to learn more about ActiveWorkbook and scripting. I will try to do as you told me but my work done. Thanks
I am trying to export current workbook to HTML site with current timestamp using this code
Private Sub btnSave_Click()
ActiveWorkbook.Save 'Save current file
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String
Application.ScreenUpdating = False ' Prevents screen refreshing.
CurrentFile = ThisWorkbook.FullName ' Remeber location of original file
NewFileType = "Web files File (*.HTML), *.html" 'Set file type
Newfilename = "Shed9-" & Format(CStr(Now), "yyyy-mm-dd_hh-mm") 'Save as timestamp
NewFile = Application.GetSaveAsFilename( _
InitialFileName:=Newfilename, _
fileFilter:=NewFileType)
If NewFile <> "" And NewFile <> "False" Then
ActiveWorkbook.SaveAs Filename:=NewFile, _
FileFormat:=xlHtml
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
End If
Application.ScreenUpdating = True
End Sub
In theory this procedure should save current file, save copy (with a time stamp, ignoring VBA) as a web page, close the web page (which to be honest I don't even want to open) and get back to the original spreadsheet.
Unfortunately the problem is with the closing part: Excel opens the web page (!) and then I have never-ending pop-up question "Do you want to save the file "Shed-9 .html?"
So how can I remove that pop-up and simply export without opening?
EDIT
I've tried to force-save the HTML copy before closing by putting the
ActBook.Save
ActBook.Close
But that leads to an error:
"An item with the same key has already been added". If thats important the workbook has multiple sheets and data taken through PowerQuery
EDIT
(The original code came from here) - the original author should receive his/her credit
Try:
ActBook.Close False
If you save a workbook in a non-excel format it will ask you if you want to save the file again anyway, without fail. Using the optional "False" parameter tells excel that you want to close without saving.
You could safely skip these lines, where you actually ask Excel to do just that (open the file):
Set ActBook = ActiveWorkbook
Workbooks.Open CurrentFile
ActBook.Close
I think what might confuse you is that have turned off screen updating, which hides what happens to you (behind the scenes).
Application.ScreenUpdating = False
This is all good if you really want to hide what's going on, but I imagine it might confuse you as long you have the Workbooks.Open code.
I have created an xlam (Excel 2007 Add-In) file to handle manipulation of various files. I am trying to write a procedure in that xlam file that removes some worksheets from an opened xlsm file, and saves it as an xlsx (i.e. without macros).
So far the only thing I can do reliably is to crash Excel whenever I reach the .SaveAs call. The crash comes as a Windows Dialog stating:
Microsoft Office Excel has stopped working, Windows can try to recover your information and restart the program. [Restart the program] [Debug the Program]
In the folder that I am saving to, after every crash I am left with a temp file (ex. filename: 7A275000 with size: 0) in the folder it tried to save to.
For posterity here some things I have tried, and all have resulted in the same crash:
Hard coded filename value ("C:\Users\myUserName\Desktop\temp.xlsx")
Prompted filename from User (shown in code below)
filename without path ("temp.xlsx")
filename without extension ("C:\Users\myUserName\Desktop\temp")
filename as existing filename without extension
filename as existing filename with .xlsx extension
instead of using wb.SaveAs, I used wb.Activate followed by ActiveWorkbook.SaveAs
I have tried FileFormat:=xlOpenXMLWorkbook and FileFormat:=xlWorkbookNormal
Saved to several different directories of varying length
Added an Error trapping statement around the .SaveAs call (it does not trap any errors, and crashes Excel just the same)
The last weird bit is when I try to do a manual Save-As on the file (i.e. navigating to the Save-As menu myself) after the ws.delete calls, Excel crashes the same way. If I manually delete the Worksheets myself, then do a manual Save-As, it saves just fine.
Here is the offending code:
Public Sub ConvertToStagingFile(ByRef wb As Workbook)
Dim reWS As Object, reFILE As Object
Dim ws As Worksheet
Set reWS = CreateObject("VBScript.regexp")
reWS.IgnoreCase = True: reWS.Global = False: reWS.MultiLine = False
Set reFILE = CreateObject("VBScript.regexp")
reFILE.IgnoreCase = True: reFILE.Global = False: reFILE.MultiLine = False
reWS.Pattern = "^(home|location settings|date reference|[\w\s]{1,8} (rating|inquire) data|pkl data - \w{1,8}|verbs - \w{1,8})"
reFILE.Pattern = "\.xlsm$"
For Each ws In wb.Worksheets
If (ws.Visible = xlSheetHidden) Or (ws.Visible = xlSheetVeryHidden) Then
ws.Visible = xlSheetVisible
End If
Select Case True
Case reWS.test(ws.name)
'// Do Nothing
Case Else
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Select
Next ws
ActiveWindow.TabRatio = 0.75
If (reFILE.test(Cached.getAdhocReportFull)) Then
Dim newName As Variant
newName = Application.GetSaveAsFilename(reFILE.Replace(Cached.getAdhocReportFull, ""), "*.xlsx")
If newName = False Then Exit Sub
wb.Activate
Application.EnableEvents = False
'// CODE RELIABLY CRASHES HERE
wb.SaveAs _
FileName:=newName, _
FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
Application.EnableEvents = True
End If
End Sub
Any help on this issue would be greatly appreciated.
I had what seems like exactly the same issue:
Excel 2013
Macro to delete worksheet in xlsm file
Subsequent calls to .Save, or manually saving file crashes Excel (same dialog as Hari)
The issue only appeared for us when we updated from .xls to the 'new' office file format
For info, our files are not that large (only 300kB)
As our intention is to replace the sheet the following works for us: rename old worksheet, create new worksheet (same name as old worksheet), delete the old worksheet. Seems to work for us. Why does it work? No idea.