VBA: Workbooks.Save & Close not saving - excel

I have the following code that is working but the line .close closes the WB without saving:
Option Explicit
Public Function updateStatus(fpath As String, fname As String, num As String)
Dim wk As String, yr As String
Dim owb As Workbook
Dim trow As Variant
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
End With
Set owb = Application.Workbooks.Open(fpath & fname)
trow = owb.Sheets(1).Range("Change" & num).Row
owb.Sheets(1).Cells(trow, 5).value = "Test"
With owb
.Save
.Close SaveChanges:=True 'This line doesn't seem to work
End With
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
End With
End Function
If I remove the line, the WB stays open and I see the change. If I add the line, and open the specific file, I see no change.

As mentioned in the comments, the code looks ok, you probably have some Data Protection enabled on your Excel, which does not allow the saving. Try to make a minimal example like this:
Option Explicit
Public Sub TestMe()
Dim owb As Workbook
Set owb = Application.Workbooks.Open("C:\Users\vityata\Desktop\Testing.xlsx")
owb.Save
owb.Close
End Sub
Then debug with F8 and see the message that you got, once you go pass by owb.Save.
Just that you know:
.Save
.Close SaveChanges:=True
With the .Save line you make the SaveChanges:=True part useless. And vice versa.

Related

VBA Copy a file as a different file extension

I am trying to build a data formatter where the user selects a file of type .xlsx and then I format it and save it as type .csv. I am needing to convert the xlsx file to a csv before I can format it. To do this, I couldn't find anything apart from opening the file, copying the used range to a worksheet on the original file, saving that worksheet as csv and then referencing that file. Despite a lack of elegance, this would work fine for the use case. However, I cannot seem to get the copying of the worksheet to be formatted down.
Here's what I'm trying for copying:
Dim active As Worksheet
Set active = ActiveSheet
With Workbooks.Open(myFile)
ActiveSheet.UsedRange.Copy
active.Paste
.Close SaveChanges:=False
End With
This, in theory, should copy the data from the file being opened to the already opened file, but it doesn't.
This works great for me:
As a sub:
Sub ConvertToCSV()
Dim MyFile As String
Dim WBtmp As Workbook
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
MyFile = "C:\Users\cameron\Documents\IDs.xlsx"
Set WBtmp = Workbooks.Open(MyFile)
With WBtmp
.SaveAs Replace(MyFile, ".xlsx", ""), xlCSV
.Close
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Or as a function
Sub TestFunc()
fConvertToCSV "C:\Users\cameron\Documents\IDs.xlsx"
End Sub
Function fConvertToCSV(MyFile As String)
Dim WBtmp As Workbook
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set WBtmp = Workbooks.Open(MyFile)
With WBtmp
.SaveAs Replace(MyFile, ".xlsx", ""), xlCSV
.Close
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Function

Save two specific worksheets in a new workbook without formulas but keeping the design

I've got a workbook where I am creating a button that allows to save two specific sheets without formula's (the purpose being that the sheets are going to be send to partners and costumers). I would like the sheets to be saved in a single document somewhere on my computer, and still have the current "design" with colors, setup etc.
I've currently written this code, which does everything that I've described, except deleting the formulas...
Sub SaveAsValues()
Dim ws As Worksheet
Worksheets(Array("frontpage", "mobile")).Copy After:= ws.Worksheets
With ActiveWorkbook
.SaveAs Filename:= "C:XXXX" & "NAME", FileFormat:= xlOpenXMLWorkbook
.Close savechanges = False
End With
End Sub
Hope you can help :-)
I have a sheet I use something similar for, I'll adjust the code a bit to work with your scenario. If you don't want the settings to change, delete the TurnOnFunctions & TurnOffFunctions subs.
This code will only break the links, not necessarily all the formulas. So if a formula references another spreadsheet it will be a static value; however, if it is a simple formula that stays within the spreadsheet it will stay that way.
Also add your workbook name to the respective area.
Sub NewWorkbooks()
'This will make seperate workbooks for each of the tabs listed
Dim wb As Workbook
Dim NewBook As Workbook
Dim ws As Worksheet
Call TurnOffFunctions
Set wb = ActiveWorkbook
For Each ws In Workbooks("YOUR WORKBOOK NAMR"). _
Worksheets(Array("frontpage", "mobile"))
ws.Copy
Set NewBook = ActiveWorkbook
With NewBook
Call break_links(NewBook)
.SaveAs Filename:="C:XXXX" & "NAME", FileFormat:=xlOpenXMLWorkbook
.Close SaveChanges:=False
End With
Next
Call TurnOnFunctions
End Sub
Sub break_links(ByRef wb As Workbook)
Dim Links As Variant
On Error Resume Next
Links = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
On Error GoTo 0
If Not IsEmpty(Links) Then
For i = 1 To UBound(Links)
wb.BreakLink _
Name:=Links(i), _
Type:=xlLinkTypeExcelLinks
Next i
End If
End Sub
Private Sub TurnOffFunctions()
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
End Sub
Private Sub TurnOnFunctions()
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
You can use yours too with this mod (untested):
Sub SaveAsValues()
Dim ws As Worksheet
Worksheets(Array("frontpage", "mobile")).Copy After:= ws.Worksheets
Call break_links ActiveWorkbook
With ActiveWorkbook
.SaveAs Filename:= "C:XXXX" & "NAME", FileFormat:= xlOpenXMLWorkbook
.Close savechanges = False
End With
End Sub
Sub break_links(ByRef wb As Workbook)
Dim Links As Variant
On Error Resume Next
Links = wb.LinkSources(Type:=xlLinkTypeExcelLinks)
On Error GoTo 0
If Not IsEmpty(Links) Then
For i = 1 To UBound(Links)
wb.BreakLink _
Name:=Links(i), _
Type:=xlLinkTypeExcelLinks
Next i
End If
End Sub

Excel VBA updating links

I am trying to set up a VBA macro to update link paths in excel. I looked up some code online and tried to put it together, and am getting errors. I am wondering if i could get some direction here. Please note that i am not a programmer by profession, just trying to reduce some manual updating work.
Cheers!
Private Sub CommandButton1_Click()
Dim FolderPath As String
Dim FSO As Object
Dim bookname As String
Dim wbook As Workbook
Dim oldname As String
Dim newname As String
oldname = "C:\Users\XX\Documents\[Broadstreet.xlsx]"
newname = "C:\Users\XX\Documents\[Broadstreet2.xlsx]"
FolderPath = "C:\Users\XX\Documents1"
With Application
.ScreenUpdating = False
.AskToUpdateLinks = False
End With
For Each Workbook In FSO.GetFolder(FolderPath).Files
bookname = Workbook.Name
MsgBox (bookname)
Set wb = Workbooks.Open(FolderPath & "\" & bookname)
ActiveWorkbook.ChangeLink oldname1, newname1, xlLinkTypeExcelLinks
wb.Close SaveChanges:=True
Next
Application.ScreenUpdating = True
End Sub
Workbooks in Folder Treatment
Loops through all Excel files (workbooks) in a folder, opens each one, changes a link from one document to another, saves the changes and closes the workbook.
xlLinkTypeExcelLinks is the default parameter of the Type
argument of the ChangeLink method and can therefore be omitted.
.Close True can be used in this way because SaveChanges is the
first argument of the Close method.
The Code
Private Sub CommandButton1_Click()
Const strOld As String = "C:\Users\XX\Documents\[Broadstreet.xlsx]"
Const strNew As String = "C:\Users\XX\Documents\[Broadstreet2.xlsx]"
Const strPath As String = "C:\Users\XX\Documents1"
Const strExt As String = "*.xls*"
Dim strName As String
With Application
.ScreenUpdating = False
.AskToUpdateLinks = False
End With
On Error GoTo ProcedureExit
strName = Dir(strPath & "\" & strExt)
Do While strName <> ""
With Workbooks.Open(strPath & "\" & strName)
.ChangeLink strOld, strNew
.Close True
End With
strName = Dir
Loop
ProcedureExit:
With Application
.AskToUpdateLinks = True
.ScreenUpdating = True
End With
End Sub

How to avoid "A file named ... already exists in this location. Do you want to replace it?" prompt on subsequent save?

I save all worksheets in a workbook as individual CSV files.
If I make a change to any of the worksheets and run the macro again, it prompts me with the "A file named ... already exists in this location. Do you want to replace it?".
If I click Yes, the prompt comes up for every worksheet. If I click no, the macro throws an error.
Is there a way to avoid the prompt?
Sub CSVAutomation()
Dim ws As Worksheet, wb As Workbook
Dim pathh As Variant
Set wb = ActiveWorkbook
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
If .Show = -1 Then 'a folder was picked
pathh = .SelectedItems(1)
End If
End With
If pathh = False Then Exit Sub 'no folder picked; pathh is false
Application.ScreenUpdating = False
For Each ws In wb.Sheets(Array("01 - Currencies", ...."14 - User Defined
Fields"))
ws.Copy
With ActiveWorkbook
'Application.DisplayAlerts = False 'to avoid overwrite warnings
' pathh is a string (variant) of the path of the folder; does not
need pathh.Path
.SaveAs pathh & "\" & ws.Name, xlCSV
.Close SaveChanges:=False
End With
Next ws
Application.ScreenUpdating = True
End Sub
Check my comment and (as Portland Runner says) you could turn off some alerts
I used this
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AutomationSecurity = msoAutomationSecurityForceDisable
Application.AskToUpdateLinks = False
Using a procedure to put inside and used every time to turn it of and another to turned on helpme a lot with all the alerts.
Sub Alerts(ScreenUpdate As Boolean, DisplayAlerts As Boolean, AutoSecurity As Boolean, AskToUpdate As Boolean)
Application.ScreenUpdating = ScreenUpdate
Application.DisplayAlerts = DisplayAlerts
Application.AutomationSecurity = IIf(AutoSecurity, msoAutomationSecurityForceDisable, msoAutomationSecurityByUI)
Application.AskToUpdateLinks = AskToUpdate
End Sub

Run VBA code on specific time

I found the following code on this web site "save Excel file as CSV" is there any way with help of you'll I can auto run this code on specific time (11:00 pm every night), and save file name as current date (hr2015-05-05), any help will be greatly appreciated. Thanks
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFileName As String
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
End With
Set Sourcewb = ActiveWorkbook
TempFileName = Sourcewb.FullName + ".csv"
'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
'Save the new workbook and close it
With Destwb
.SaveAs Filename:=TempFileName, FileFormat:=xlCSV, ConflictResolution:=xlLocalSessionChanges
.Close SaveChanges:=False
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub
Edit fixed tag issue
I would do this one of two ways.
One would be through windows task scheduler. Where you will set up a task to open Excel and run it that way. See http://www.mrexcel.com/forum/excel-questions/302970-task-scheduler-vbulletin-script-auto-open-excel.html
Or
Use the code
Application.OnTime TimeValue("23:00:00"), SUBNAMEHERE
Changing SUBNAMEHERE to the sub where the code is. Not sure if it will run the beforesave part through
EDIT added code to have filename
Change TempFileName = Sourcewb.FullName + ".csv" to be
TempFileName = Sourcewb.FullName & " hr" & format(now,"YYYY-MM-DD") & ".csv"

Resources