I'd like to create several new workbooks. The VBA code below runs fine with Excel 365 and 2010. BUT with Excel 2013 or 2016, it runs fine the first time (and create the files)... and on the second run, Excel crashes without any error message.
If I run it step by step, I see that it's the SaveAs line that causes the crash.
I tried to kill the file before saving, too. To use a timer...
I tried to repair Office, to rename a HKEY (Identities), I tried to run it on 2 different windows (7 or 10). Nothing helps :/
Sub ExtraireType()
Dim shVentes As Worksheet
Dim rngVentes As Range
Dim rngTypes As Range
Dim shNew As Worksheet
Dim wkbNew As Workbook
Dim strPath As String
Dim zaza As Range
Application.DisplayAlerts = False
Set shVentes = ThisWorkbook.Worksheets("Ventes")
Set rngVentes = shVentes.Range("A1").CurrentRegion
Set rngTypes = ThisWorkbook.Worksheets("Liste").Range("A2:A4")
strPath = ThisWorkbook.Path
For Each zaza In rngTypes
rngVentes.AutoFilter
rngVentes.AutoFilter field:=3, Criteria1:=zaza.Value
rngVentes.Copy
Set shNew = ThisWorkbook.Worksheets.Add
shNew.Paste
Application.CutCopyMode = False
shNew.Move
Set wkbNew = ActiveWorkbook
wkbNew.SaveAs strPath & "\Type" & zaza.Value & Format(Date, "yyyymmdd")
wkbNew.Close
Set shNew = Nothing
Set wkbNew = Nothing
Next zaza
Set rngVentes = Nothing
Set shVentes = Nothing
Set rngTypes = Nothing
Application.DisplayAlerts = False
End Sub
This code runs well with Excel 2010 or 2019/365. But I have to use it with 2013 or 2016 :(
What am I doing wrong? Thanks for any help !
I was having this problem as well and have found a workaround - use .SaveCopyAs instead.
In the below example, .SaveAs crashes Excel every second time if I've left the Excel spreadsheet open and deleted the resultant file, whilst .SaveCopyAs saves every time irrespective. The only difference between the two is that .SaveAs has more options for how to save whereas .SaveCopyAs's only option is the filename.
Private Sub SaveAsExcelFile(TempExcelFile As Workbook, _
NewFullFileName as string, _
Optional FileFormat As XlFileFormat = xlOpenXMLWorkbook, _
Optional CreateBackup As Boolean = False)
'
' created & last edited 2020-03-06 by Timothy Daniel Cox
'
' For this example it is assumed the new file name is valid and in .xlsx format
'
Dim NewFullFileName2 as string
NewFullFileName2 = Replace(NewFullFileName, ".xlsx", "2.xlsx")
Application.EnableEvents = False
TempExcelFile.SaveCopyAs Filename:=NewFullFileName 'doesn't crash here on 2nd run
TempExcelFile.SaveAs Filename:=NewFullFileName2, FileFormat:=FileFormat, _
CreateBackup:=False 'will crash here on 2nd run
Application.EnableEvents = true
End Sub
I still think there is a bug in Excel regarding the .SaveAs however:
There's a long thread at
https://chandoo.org/forum/threads/worksheet-save-as-to-new-workbook-crashes-excel-on-second-run.40136/#post-241024
which after meandering has an apparent resolution as linked but - having
downloaded the file to see what changes have been made - he only
appears to have changed the output directory and removed a
conflicting fileformat which was set. IMO it did not resolve the
issue.
There's another similar unsolved thread at https://www.reddit.com/r/excel/comments/58fqlg/my_vba_code_works_at_first_but_if_used_twice_in_a/ which has no useful answers.
The one of the reasons that your code crash (it crushed in my case, Excel 2016), might be because you didn't add file extension at the end of:
wkbNew.SaveAs strPath & "\Type" & zaza.Value & Format(Date, "yyyymmdd")
so it might be like:
wkbNew.SaveAs strPath & "\Type" & zaza.Value & Format(Date, "yyyymmdd") & ".xlsx"
Hope it helps.
Related
I'm trying to make an Excel VBA macro to automate my saves. So if it is 2022 or 2023 and it is either the month of January, February, march, etc. The file will save in that year's folder and under that month's folder. However, I'm not the best at If, Then, Else statements. I made this VBA and it doesn't work after I tried to make it create folders if they don't exist.
Sub auto-organize-save()
'
' auto-organize-save Macro
'
'
'this is for date
Dim dateOne As Date
'This is for making new folder
Dim fdObj As Object
Application.ScreenUpdating = False
Set fdObj = CreateObject("Scripting.FileSystemObject")
If fdObj.FolderExists("C:\temp\april") Then
If dateOne = April Then
ActiveWorkbook.SaveAs Filename:= _
"C:\temp\april\save3.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
Else
fdObj.CreateFolder ("C:\temp\april")
End If
End If
End Sub
i modified it a bit further and I'm getting results but i need to figure out how to change the name of the folder to display the following:
"04 - APR" - 4 means the 4th month and APR is the abbreviated version. With the help of the user trincot following works perfectly.
Sub auto_organize_save1()
Dim fdObj As Object
Dim folder As String
Set fdObj = CreateObject("Scripting.FileSystemObject")
folderYear = "C:\temp\" & Format(Now, "YYYY") & "\"
folderMonth = "C:\temp\" & Format(Now, "YYYY") & "\" & Format(Now, "MM-MMM") & "\"
If Not fdObj.FolderExists(folderYear) Then
MkDir folderYear
End If
If Not fdObj.FolderExists(folderMonth) Then
MkDir folderMonth
End If
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=folderMonth & "example2.xlsx"
Application.DisplayAlerts = False
End Sub
Some issues:
Your code is not getting a particular date, it just uses the default value of dateOne. Instead use Now.
dateOne = April references an undefined variable April. In order to get the month of a date, use the Month function, and compare it with a number.
Hard coding months, like "April", is not going to give you elegant code. Moreover, this is not even the format you are asking for ("4 - APR").
I would suggest to prefix the month 4 with a zero so it always has two digits, and will look better when other entries are "12 - DEC", ...etc.
Application.ScreenUpdating = False should only be used when you already have well working code. Don't use it for as long your code is not working. And if you use it, add also the opposite: Application.ScreenUpdating = True
I'm not sure it is a good idea to call your file always "save3", but as I got no information about this aspect, I just left it as you had it.
Here is some code you could use:
Sub auto_organize_save()
Dim fdObj As Object
Dim folder As String
Set fdObj = CreateObject("Scripting.FileSystemObject")
folder = "C:\temp\" & Format(Now, "MM-MMM") & "\"
If Not fdObj.FolderExists(folder) Then
MkDir folder
End If
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=folder & "save3.xlsx"
Application.DisplayAlerts = True
End Sub
I've got a need to open some Excel files and "pause" then close them. In this process I run one macro on opening, and another on closing. The opening one works fine because it is done as each file is opened. But the closing part of the code I can't get it to run the correct macro. They have the same names, but the file contests are different, and what the macro does per file is different.
This is the gist of what I'm doing now
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
path = "\\Gaalpa1cdfile19\north_sa_staff\Reports\Rpt-ProductionCurves\"
filename2018P1 = "2018 P1.xlsm"
Set xlbook2018P1 = xlApp.WorkBooks.Open(path & filename2018P1)
' Run Macro
xlApp.Run "AutoRefresh"
filename2018P3 = "P3 2018 HRR.xlsm"
Set xlbook2018P3 = xlApp.WorkBooks.Open(path & filename2018P3)
'Run Macro
xlApp.Run "AutoRefresh"
'My "pause"
WScript.Echo ("All Files were" & Chr(013) & _
"opened and refreshed, update ppt before OK" & Chr(013) & _
" DO NOT CLICK OK" & Chr(013))
'==========================
'Below is the trouble spot.
'==========================
xlapp.Run "'" & filename2018P1 & "'" & "!AutoPublish"
xlbook2018P1.Close False
Set xlbook2018P1 = Nothing
xlapp.run "'" & filename2018P3 & "'" & "!AutoPublish"
xlbook2018P3.Close False
Set xlbook2018P3 = Nothing
The first part works fine, but trying to run the file's respective AutoPublish macro does not. The code works fine if I leave out that Run line. (The real file names have spaces and I had to add the single quotes to get it to accept the filename.)
What it appears to be doing is using the macros from the last file opened, not the one it's directed to use it the run line. I think I need a way to "select" the correct file, or give it focus so the macro could run without an explicit filename argument, which it appears to be ignoring anyway.
EDIT:
Solution was:
xlbook2018P1.Activate ' This fixed it, I think
xlapp.Run "'" & filename2018P1 & "'" & "!AutoPublish"
xlbook2018P1.Close False
Set xlbook2018P1 = Nothing
xlbook2018P3.Activate
xlapp.run "'" & filename2018P3 & "'" & "!AutoPublish"
xlbook2018P3.Close False
Set xlbook2018P3 = Nothing
When tackling similar tasks, I usually work around by implementing a master Excel file first, and call a sub in this master file via VBS. The advantage to me seems it is way easier to fullfill all tasks in the VBA of the master file rather than having to code all that in VBS.
Create a master file, e.g. "Master.xlsm", list all your files you need to open on a sheet named "Files" in column A, starting in row 1.
Insert a module and place the following sub in this module:
Sub Main()
Dim strPath As String
Dim strFile As String
Dim lRow As Long
Dim i As Long
Dim k As Integer
Dim n As Long
Dim wb(1 To 3) As Workbook
Dim wbTest As Workbook
Set wbMaster = ThisWorkbook
strPath = "\\Gaalpa1cdfile19\north_sa_staff\Reports\Rpt-ProductionCurves\"
'Check how many files you need to open
With Sheets("Files")
lRow = Sheets("Files").Range("A" & .Rows.Count).End(xlUp).Row
End With
'open all available files
For i = 1 To lRow
Workbooks.Open (wbMaster.Sheets("Files").Range("A" & i).Value)
Next
'now run the two macros in each open file
For k = 2 To Workbooks.Count 'this will work only if your master file is the only one open when starting the sub!
Workbooks(k).Run "'" & Workbooks(k).Name & "'!AutoRefresh"
DoEvents
Workbooks(k).Run "'" & Workbooks(k).Name & "'!AutoPublish"
DoEvents
Next
'and close all files previously opened except for the master file
For n = Workbooks.Count To 2 Step -1
Workbooks(n).Close False
Next
End Sub
It seems like a possible explanation for what you're seeing is that your AutoPublish macro refers to ActiveWorkbook and not the safer ThisWorkbook. If another workbook is active when it's called that could lead to unexpected results.
I have a macro that will open another workbook from a network location, compare some values in a range, copy/paste any that are different, and then close the file. I use variables to open the file, because the appropriate filename is based on the current date. I also set Application.ScreenUpdating = False, and Application.EnableEvents = False
for some reason, the code has begun to hang on the worksheets.open line and I can't even CTRL+Break to get out of it. I have to manually close Excel and sometimes it give me an error message, complaining about there not being "enough memory to complete this action".
I can put a stop in the code and confirmed the variables are supplying the correct string, which equates to:
"\Clarkbg01\public\PRODUCTION MEETING\PROD MEETING 3-21-18.xlsm"
I can paste this into Windows Explorer and it will open right up with no issues. I can manually select the file from Explorer and it will open with no issues. I can paste the following line into the immediate window and it will hang...
workbooks.Open("\\Clarkbg01\public\PRODUCTION MEETING\PROD MEETING 3-21-18.xlsm")
This happens even if I open a blank sheet and execute that line from the immediate window.
from my macro, stepping through the code goes without a hitch. I can verify all the variables are correct, but when it steps across workbooks.open, it hangs.
I have other macros that open workbooks, do much more complicated routines, then close them with zero issues, but I'm really stuck on why this one is giving me so many problems.
Any ideas?
Here is the code:
'This will open the most recent meeting file and copy over the latest for jobs flagged with offsets
Dim Path As String
Path = ThisWorkbook.Path
'Debug.Print Path
Dim FileDate As String
FileDate = ThisWorkbook.Sheets("MEETING").Range("3:3").Find("PREVIOUS NOTES").Offset(-1, 0).Text
'Debug.Print FileDate
Dim FileName As String
FileName = "PROD MEETING " & FileDate & ".xlsm"
Debug.Print "Looking up Offsets from: " & FileName
Dim TargetFile As String
TargetFile = Path & "\" & FileName
Debug.Print TargetFile
Application.ScreenUpdating = False
Application.EnableEvents = False
'The old way I was opening it...
'Workbooks.Open FileName:=Path & "\" & FileName, UpdateLinks:=False ', ReadOnly:=True
'The most recent way to open
Dim wb As Workbook
Set wb = Workbooks.Open(TargetFile, UpdateLinks:=False, ReadOnly:=True)
'Do Stuff
wb.Close savechanges:=False
Application.ScreenUpdating = True
Application.EnableEvents = True
MsgBox "Offsets should now reflect settings made in meeting on " & FileDate
End Sub
If the workbook you're opening contains code in the Workbook_Open event then this will attempt to execute when the event fires .
To stop this behaviour use the Application.AutomationSecurity Property.
Public Sub Test()
Dim OriginalSecuritySetting As MsoAutomationSecurity
OriginalSecuritySetting = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable
'Open other workbook
Application.AutomationSecurity = OriginalSecuritySetting
End Sub
I have a code in excel VBA that saves a workbook with a coded path and filename which works perfectly on my computer at home running windows 8 and office 2013.
When I try to use it on my work computer which runs windows XP and office 2003 it ignores the coded path and file name and opens the save as dialogue box which defaults to the My Documents directory.
The intent is for the users at work to click save and the file will automatically go to a network drive with a personalised filename. They should not have to select a path or filename.
I have been testing with the path C:\Temp\ and saving a plain .XLS file which should work on both versions of Excel.
I tried it without disabling alerts and it gave no clues as to why it ignores the path and filename. I have also tried fileformat:=xlnormal etc. with no luck.
Why is this happening and how do I fix it?
Here is the code:
Sub FeedBackSave()
' Save the Feedback worksheet created by the user to the network drive using the path copied from
' the Management workhseet cell A11, the resource name copied from cell A1 and todays date as the filename.
Dim wsh As Worksheet
Dim nme, pth, TodaysDate As String
TodaysDate = format(Now, "dd-mm-yy")
nme = Range("A1").Value
pth = Worksheets("Management").Range("A11").Value
Application.ScreenUpdating = False
Application.DisplayAlerts = False ' Prevents alerts like incorrect file type or overwrite file y/n to permit 1 click save
'Save Feedback worksheet
ActiveWorkbook.Close SaveChanges:=True, Filename:=pth & "FeedBack " & nme & " " & TodaysDate & ".xls"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Saveas Before you close the workbook, might help., check the ranges, not sure if they are on the same sheet or not.
Sub FeedBackSave()
' Save the Feedback worksheet created by the user to the network drive using the path copied from
' the Management workhseet cell A11, the resource name copied from cell A1 and todays date as the filename.
Dim wsh As Worksheet
Dim nme As String, pth As String, TodaysDate As String, FName As String
Set ws = Worksheets("Management")
TodaysDate = Format(Now, "dd-mm-yy")
nme = Range("A1").Value
pth = ws.Range("A11").Value
FName = pth & nme & "-" & TodaysDate & ".xls"
Application.DisplayAlerts = 0
With ActiveWorkbook
.SaveAs FileName:=FName
.Close
End With
End Sub
In this section of code, Excel ALWAYS prompts: "File already exists, do you want to overwrite?"
Application.DisplayAlerts = False
Set xls = CreateObject("Excel.Application")
Set wb = xls.Workbooks.Add
fullFilePath = importFolderPath & "\" & "A.xlsx"
wb.SaveAs fullFilePath, AccessMode:=xlExclusive, ConflictResolution:=True
wb.Close(True)
Why does db.SaveAs always prompt me to overwrite existing file if I have DisplayAlerts = False?
To hide the prompt set xls.DisplayAlerts = False
ConflictResolution is not a true or false property, it should be xlLocalSessionChanges
Note that this has nothing to do with displaying the Overwrite prompt though!
Set xls = CreateObject("Excel.Application")
xls.DisplayAlerts = False
Set wb = xls.Workbooks.Add
fullFilePath = importFolderPath & "\" & "A.xlsx"
wb.SaveAs fullFilePath, AccessMode:=xlExclusive,ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
wb.Close (True)
I recommend that before executing SaveAs, delete the file if it exists.
If Dir("f:ull\path\with\filename.xls") <> "" Then
Kill "f:ull\path\with\filename.xls"
End If
It's easier than setting DisplayAlerts off and on, plus if DisplayAlerts remains off due to code crash, it can cause problems if you work with Excel in the same session.
To split the difference of opinion
I prefer:
xls.DisplayAlerts = False
wb.SaveAs fullFilePath, AccessMode:=xlExclusive, ConflictResolution:=xlLocalSessionChanges
xls.DisplayAlerts = True
Finally got it right, everything above is so confusing.
Sub SaveAndClose()
Dim wb1 As String
Application.Calculation = xlCalculationAutomatic
'this only works if the following equation is in C43 in sheet "data"
'=LEFT(MID(CELL("filename",C41),SEARCH("[",CELL("filename",C41))+1, SEARCH("]",CELL("filename",C41))-SEARCH("[",CELL("filename",C41))-1),75)
'the vba equation has double quotes everywhere that is how you use a formula in vba.
'vba code recreates this incase it gets deleted by accident.
ThisWorkbook.Sheets("Data").Range("C43").ClearContents
ThisWorkbook.Sheets("Data").Range("C43").Formula2R1C1 = _
"=LEFT(MID(CELL(""filename"",R[-2]C),SEARCH(""["",CELL(""filename"",R[-2]C))+1, SEARCH(""]"",CELL(""filename"",R[-2]C))-SEARCH(""["",CELL(""filename"",R[-2]C))-1),75)"
'https://techcommunity.microsoft.com/t5/excel/cell-reference-containing-file-name-changes-when-opening-second/m-p/2417030
wb1 = ThisWorkbook.Sheets("Data").Range("C43").Text
If ThisWorkbook.Name = wb1 Then
'MsgBox (wb1)
Workbooks(wb1).Close SaveChanges:=True
End If
End Sub
this will allow the spreadsheet to determine its own name and then only then can the sub run something against that name. this is so when you have multiple sheets running duplicate sheets but with different names you don't accidently close the wrong sheet. this is a huge win for CYA in my book.
This will also bypass the overwrite message too, you can have the code automatically run in the background on another workbook while you are working in a different workbook without being affected.