How to use workbook.saveas with automatic Overwrite - excel

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.

Related

Unprotect the Excel workbooks in a specified path and refresh the workbook conection and then protect the workbooks

To elaborate(Unprotect the Excel workbooks in a specified path and refresh the workbook conection and then protec the workbooks)
I've a four workbooks in a specific path used by different users. I've used the power query to consolidate the workbooks with my Mastersheet using Data--> Refreshall. Some of the internal team issues I'm in a situation of protecting the workbooks.
After the initiation, the mastersheet won't get refreshed it indicates '[DataFormat.Error] File contains corrupted data.'. When i'm unprotecting the workbook, it worked properly.
So, please help me with this.
Option Explicit
Sub Unlock_Refresh()
Dim wb As Workbook, ws As Worksheet
Dim Filepath As String, Filename As String
Dim n As Long
Const pass = "1519"
Filepath = Worksheets("Sheet2").Range("A1").Value
If Right(Filepath, 1) <> "\" Then Filepath = Filepath & "\"
Filename = Dir(Filepath & "*.xls*")
Application.ScreenUpdating = False
Do While Filename <> ""
Set wb = Workbooks.Open(Filepath & Filename, Password:=pass)
With wb
.Unprotect Password:=pass
.RefreshAll
Application.Wait Now + TimeValue("00:00:10")
.Protect Password:=pass
.Close savechanges:=True
End With
n = n + 1
Filename = Dir
Loop
Application.ScreenUpdating = True
MsgBox n & " workbooks refreshed in " & vbLf & Filepath, vbInformation
End Sub
Don't know if this is related to the issue you're having or not, but there appears to be some logical disconnections in your code.
Line:
Set wb = Workbooks.Open(Filepath & Filename, Password:=pass)
Opens a workbook using a password that would be required only if the book was password protected to open. I note here:
a) this line of code will work even of no 'password-to-open' was set
b) as the code doesn't set a password-to-open, one assumes that is done manually?
Lines:
.Unprotect Password:=pass
.RefreshAll
.Protect Password:=pass
Un-protects the book-structure (and windows), refreshes external data, then re-protects the book-structure (only). I note here:
a) book-structure protection doesn't need to be off, in order to refresh external data
b) this doesn't set the 'password-to-open'
So it's unclear why the un-protect and re-protect logic cycle is there?
In case it's relevant, the following code would be used to set the 'password-to-open':
[workbook].Protect = pass

Excel 2016/2013 crashes running SaveAs method 2 times

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.

Access VBA script to open and save excel files on network drive doesnt save files

I have a script in Access that is supposed to loop through excel files in a shared network drive, open and save them.
When running the script on a local folder it works as intended, but when running it on the network drive a popup appears saying:'A file with this name already exists in this location, do you want to save it anyways? When I press yes the popup closes, but upon checking the timestamp of the files, non of them have been overwritten.
Here is the script:
Sub demo()
Dim directory As String, fileName As String
Dim Mywb As Workbook
Dim app As New Excel.Application
app.Visible = True
directory = "Y:\E. Data Hub\4. KPIs\C. Price Competitiveness\2018\07 July\DT\"
fileName = Dir(directory & "*.xls")
Do While fileName <> ""
Workbooks.Open (directory & fileName)
fileName = Dir()
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Loop
app.Quit
End Sub
Ideally I wouldnt even receive those popups that I have to confirm manually and of course the files should be saved/overwritten.
Edit: I think the issue seems to be that the files are opened in read only mode. I tried fixing that issue by adding 'ReadOnly:=False, Notify:=False' to my Workbooks.Open command, but this does not work and the files still get opened in read only mode.
Second edit: Check below for a solution I answered my own question.
I found a solution to my specific issue so for anyone having the same issue in the future:
For me the issue was a result of the files being opened in 'read only' mode in excel.
To solve this I included
ActiveWorkbook.LockServerFile
into my loop.
This is the equivalent of pressing the 'edit workbook' button on excel.
My full code now looks like this:
Sub demo()
Dim directory As String, fileName As String
Dim Mywb As Workbook
Dim app As New Excel.Application
app.Visible = True
directory = "Y:\E. Data Hub\4. KPIs\C. Price Competitiveness\2018\07 July\DT\"
fileName = Dir(directory & "*.xls")
Application.Echo False
DoCmd.SetWarnings False
Do While fileName <> ""
Workbooks.Open (directory & fileName)
fileName = Dir()
ActiveWorkbook.LockServerFile
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Loop
app.Quit
DoCmd.SetWarnings True
Application.Echo True
End Sub
You can stop most message that excel asks the user by switching this option:
Application.DisplayAlerts
so in your code it would look like:
Public Sub demo()
Dim directory As String, fileName As String
Dim Mywb As Workbook
Dim app As New Excel.Application
app.Visible = True
directory = "Y:\E. Data Hub\4. KPIs\C. Price Competitiveness\2018\07 July\DT\"
fileName = Dir(directory & "*.xls")
Application.DisplayAlerts = False
Do While fileName <> ""
Workbooks.Open directory & fileName
fileName = Dir()
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Loop
Application.DisplayAlerts = True
app.Quit
End Sub

Workbooks.open hangs

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

Excel rebooting while copying sheets from multiple books

I built a program to copy sheet one from all books in a directory, and paste them into the active workbook. I have roughly 1200 books in the directory, and without fail each time I run it excel reboots after around #125. No error messages. Anyway of getting around this?
Sub GetSheets()
Path = "C:\Users\bdaly\Desktop\Formulas\smaller sample\"
Dim DestWB As Workbook
Set DestWB = ThisWorkbook
Filename = Dir(Path & "*.xls")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
Sheets("Sheet1").Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
Application.DisplayAlerts = False
Workbooks(Filename).Close
Application.DisplayAlerts = True
Filename = Left(Left(Filename, Len(Filename) - 4), 31)
DestWB.Sheets(DestWB.Sheets.Count).Name = Filename
Filename = Dir()
Loop
End Sub
Edit: As advised I removed the offending file, Excel still reboots after 124 loops.
Not sure if this is going to address the problem at hand, but it will help in debugging or exposing the problem.
Put simply, qualify your source data.
Include Dim SourceWB as Workbook. This could be done where you declare DestWB.
Change Workbooks.Open Filename:=Path & Filename, ReadOnly:=True to Set SourceWB = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True, Editable:=True)
Change Sheets("Sheet1").Copy After:=DestWB.Sheets(DestWB.Sheets.Count) to SourceWB.Sheets("Sheet1").Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
Change Workbooks(Filename).Close to SourceWB.Close
Unfortunately, the .Copy command is a Sub, not a Function - would be so much more neater if it provided a reference to the sheet that has just been created as you could then use it in DestWB.Sheets(DestWB.Sheets.Count).Name = Filename
I suggest, for debugging purposes, keeping the DisplayAlerts on for now. This may provide a clue as to where the fault is happening.
Also include some debug.print lines in your loop. Finding where in the loop it crashes could help diagnose the issue. Make them a little descriptive, the ones I would think of are:
debug.print "Entered loop"
debug.print "Copied file"
debug.print "renamed file"
'debug.print "new FileName is " & FileName`.
You get the idea.
Try the AddIn from the link below.
https://www.rondebruin.nl/win/addins/rdbmerge.htm

Resources