Why does VBA ActiveWorkbook.SaveAs change the open spreadsheet? - excel

My function is as follows:
Sub saveCSV()
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"c:\temp\file.csv", FileFormat:=xlCSV _
, CreateBackup:=False
End Sub
I'm trying to export the active worksheet to CSV. When I run the code in the title, Book1.xlsm changes to file.csv and Sheet1 changes to file. The export works fine. How can I do the export without these unwanted side effects?

That's always how SaveAs has worked. The only way to get around this is to copy the worksheet and do a SaveAs on the copy, then close it.
EDIT: I should add an example as it's not that difficult to do. Here's a quick example that copies the ActiveSheet to a new workbook.
Dim wbk As Workbook
Set wbk = Workbooks.Add
ActiveSheet.Copy wbk.Sheets(1) ' Copy activesheet before the first sheet of wbk
wbk.SaveAs ....
wbk.Close
A complicated workbook may get issues with links and macros, but in ordinary scenarios this is safe.
EDIT 2: I'm aware of what you're trying to do, as your other question was about trying to trigger an export on every change to the sheet. This copy sheet approach presented here is likely to be highly disruptive.
My suggestion is to write a CSV file by hand to minimise GUI interruption. The sheet is likely to become unusable if the saves are occurring at high frequency. I wouldn't lay the blame for this at the door of Excel, it simply wasn't built for rapid saves done behind the scenes.

Here's a little routine that does what you want by operating on a copy of the original ... copy made via file scripting object. Hardcoded to operate on "ThisWorkbook" as opposed to active workbook & presumes ".xlsm" suffix - could tweak this to do the job I think:
Public Sub SaveCopyAsCsv()
Dim sThisFile As String: sThisFile = ThisWorkbook.FullName
Dim sCsvFile As String: sTempFile = Replace(sThisFile, ".xlsm", "_TEMP.xlsm")
ThisWorkbook.Save ' save the current workbook
' copy the saved workbook ABC.xlsm to TEMP_ABC.xlsm
Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Call fso.deletefile(sTempFile, True) ' deletes prev temp file if it exists
On Error GoTo 0
Call fso.CopyFile(sThisFile, sTempFile, True)
' open the temp file & save as CSV
Dim wbTemp As Workbook
Set wbTemp = Workbooks.Open(sTempFile) ' open the temp file in excel
' your prev code to save as CSV
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:="c:\temp\file.csv", FileFormat:=xlCSV, CreateBackup:=False
wbTemp.Close ' close the temp file now that the copy has been made
Application.DisplayAlerts = True
' delete the temp file (if you want)
On Error Resume Next
Call fso.deletefile(sTempFile, True) ' deletes the temp file
On Error GoTo 0
End Sub

Related

Convert .xlsm to .csv [duplicate]

I appreciate there are lots of entries like save individual excel sheets as csv
and Export each sheet to a separate csv file - But I want to save a single worksheet in a workbook.
My code in my xlsm file has a params and data sheet. I create a worksheet copy of the data with pasted values and then want to save it as csv. Currently my whole workbook changes name and becomes a csv.
How do I "save as csv" a single sheet in an Excel workbook?
Is there a Worksheet.SaveAs or do I have to move my data sheet to another workbook and save it that way?
CODE SAMPLE
' [Sample so some DIMs and parameters passed in left out]
Dim s1 as Worksheet
Dim s2 as Worksheet
Set s1 = ThisWorkbook.Sheets(strSourceSheet)
' copy across
s1.Range(s1.Cells(1, 1), s1.Cells(lastrow, lastcol)).Copy
' Create new empty worksheet for holding values
Set s2 = Worksheets.Add
s2.Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
' save sheet
s2.Activate
strFullname = strPath & strFilename
' >>> BIT THAT NEEDS FIXIN'
s2.SaveAs Filename:=strFullname, _
FileFormat:=xlCSV, CreateBackup:=True
' Can I do Worksheets.SaveAs?
Using Windows 10 and Office 365
This code works fine for me.
Sub test()
Application.DisplayAlerts = False
ThisWorkbook.Sheets(strSourceSheet).Copy
ActiveWorkbook.SaveAs Filename:=strFullname, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub
It's making a copy of the entire strSourceSheet sheet, which opens a new workbook, which we can then save as a .csv file, then it closes the newly saved .csv file, not messing up file name on your original file.
This is fairly generic
Sub WriteCSVs()
Dim mySheet As Worksheet
Dim myPath As String
'Application.DisplayAlerts = False
For Each mySheet In ActiveWorkbook.Worksheets
myPath = "\\myserver\myfolder\"
ActiveWorkbook.Sheets(mySheet.Index).Copy
ActiveWorkbook.SaveAs Filename:=myPath & mySheet.Name, FileFormat:=xlCSV, CreateBackup:=True
ActiveWorkbook.Close
Next mySheet
'Application.DisplayAlerts = True
End Sub
You just need to save the workbook as a CSV file.
Excel will pop up a dialog warning that you are saving to a single sheet, but you can suppress the warning with Application.DisplayAlerts = False.
Don't forget to put it back to true though.
Coming to this question several years later, I have found a method that works much better for myself. This is because the worksheet(s) I'm trying to save are large and full of calculations, and they take an inconvenient amount of time to copy to a new sheet.
In order to speed up the process, it saves the current worksheet and then simply reopens it, closing the unwanted .csv window:
Sub SaveThisSheetInParticular()
Dim path As String
path = ThisWorkbook.FullName
Application.DisplayAlerts = False
Worksheets("<Sheet Name>").SaveAs Filename:=ThisWorkbook.path & "\<File Name>", FileFormat:=xlCSV
Application.Workbooks.Open (path)
Application.DisplayAlerts = True
Workbooks("<File Name>.csv").Close
End Sub
Here the Sheet and csv filename are hardcoded, since nobody but the macro creator (me) should be messing with them. However, it could just as easily be changed to store and use the Active Sheet name in order to export the current sheet whenever the macro is called.
Note that you can do this with multiple sheets, you simply have to use the last filename in the close statement:
Worksheets("<Sheet 1>").SaveAs Filename:=ThisWorkbook.path & "\<File 1>", FileFormat:=xlCSV
Worksheets("<Sheet 2>").SaveAs Filename:=ThisWorkbook.path & "\<File 2>", FileFormat:=xlCSV
[...]
Workbooks("<File 2>.csv").Close

Using VBA in Excel to force save in directory

I have a huge Excel spreadsheet that I need to allow access to a large set of users so they can manipulate it for their customers, but I don't want them to be able to overwrite the original file (a variable easily set in Excel) or save their file outside the current folder - so I want to force them in a "saveas" mode, and force the file to be saved in that folder. Otherwise, they won't be able to save. I'm not much of a VBA person, and I've found a lot of examples that may work, but nothing seems to be exactly what I need or maybe I'm not smart enough to figure it out. I found this code, but I'm not sure it FORCES the issue. Help?
I've tried to manage this in GPOs but everything seems to give them access to download the folder and save in other places.
Sub ExampleToSaveWorkbookSet()
Dim wkb As Workbook
'Adding New Workbook
Set wkb = Workbooks.Add
'Saving the Workbook
wkb.SaveAs "C:\WorkbookName.xls"
'OR
'wkb.SaveAs Filename:="C:\WorkbookName1.xls"
End Sub
Expected output is the amended Excel file saved in the original directory with a different name, or not at all.
Here's a macro that runs on open and immediately saves as .xlsx to a user location you can specify. Unfortunately the original needs to be .xlsm to store a macro.
This macro is to be located in the "ThisWorkbook" object. It will exit before making a copy when you open the workbook.
Private Sub Workbook_Open()
Dim wb As Workbook
Set wb = ActiveWorkbook
vWbName = wb.Name
vUserProf = Environ("USERPROFILE")
vx = InStr(1, vUserProf, "Users\")
If "<Use your own profileID>" = Mid(vUserProf, vx + 6) Then Exit Sub
vDir = vUserProf & "\Downloads\"
vWbName = Left(vWbName, Len(vWbName) - 5) & ".xlsx"
wb.SaveAs vDir & vWbName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
MsgBox "You are now using a copy of the original"
End Sub

Copy a sheet to a New workbook (of one sheet) without opening it

I would like to copy a sheet from ActiveWorkbook, to a New Created workbook.
The New created workbook, will contains the copied sheet ONLY.
I also don't want it to open while copiying the sheet. I want to copy the sheet to the new created workbook silently.
If I do something like the following, the new created book is with 3 sheets, not one only, and it's opening while copiying. and also it's asking me if i want to saved it with Macro, while I only want to copy the sheet1, so no need for any macro with it, How to fix that to fits my needs ?
ThisWorkbook.Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs "C:\DestinationWb.xlsx", FileFormat:=51
The newly created workbook will have to be open - otherwise how would you save it? - but toggling Application.ScreenUpdating might facilitate the "silent" copy you're looking for. Toggling Application.DisplayAlerts will also suppress alerts as needed.
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets("Sheet1").Copy
ActiveWorkbook.SaveAs FileName:="C:\DestinationWb.xlsx", FileFormat:=51
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Hello, I just tried the code you provided, it still opens the book for about 1-2 seconds and close it. the user will clearly see that the book is opened. is there any other way, not forcely the sheet.copy or it's the only way to copy ? – JustGreat 50 mins ago
The only way I can think of in such a scenario is to do the following.
Logic:
Use the .SaveCopyAs method to save a copy of the existing workbook. You can read more about .SaveCopyAs HERE
Create another instance of Excel and Hide it
Open the copy in that instance
Delete all sheets except the one which you want.
Save and Close and finally quit the Excel instance.
Code:
Sub Sample()
Dim thisWb As Workbook
'~~> New File Name
Dim NewFile As String
NewFile = "C:\Users\routs\Desktop\New folder\DestinationWb.xlsx"
'~~> Sheets that you want to copy across
Dim SheetToCopy As String
SheetToCopy = "Sidd"
Set thisWb = ThisWorkbook
'~~> Save a copy of the current workbook to the new path
thisWb.SaveCopyAs NewFile
'~~> Create a new Excel instance and keep it hidden
Dim tmpExcelApp As Object
Dim ws As Object, thatWb As Object
Set tmpExcelApp = CreateObject("Excel.Application")
tmpExcelApp.Visible = False
'~~> Open the copy file in hidden instance
Set thatWb = tmpExcelApp.Workbooks.Open(NewFile)
'~~> Delete all sheets except the one we copied
tmpExcelApp.DisplayAlerts = False
For Each ws In thatWb.Worksheets
If ws.Name <> SheetToCopy Then ws.Delete
Next ws
tmpExcelApp.DisplayAlerts = True
'~~> Save and close
thatWb.Close (True)
'~~> Quit Excel Instance
tmpExcelApp.Quit
MsgBox "Done"
End Sub

Duplicate workbook when saved into OneDrive sync folder

I am having this weird problem when saving my sheet into onedrive sync folder. Basically what i am doing with the below code is that I copy a sheet from my workbook then save it into a sync folder. When it does this, a saved copy with the filename that is stored in a specific cell together with another copy with the same saved name with a 1 at the back of the file name will appear in the sync folder. When i step over to test the code, no such error occur. The error only occur if I run the macro. May i know why? Below is my code;
Sub SheetSplit1()
'
'Creates an individual workbook for each worksheet in the active workbook.
'
Dim wbDest As Workbook
Dim wbSource As Workbook
Dim sht As Object
Dim strSavePath As String
Dim sname As String
Dim relativepath As String
Set wbSource = ActiveWorkbook
'For Each sht In wbSource.Sheets
Sheet10.Copy
Set wbDest = ActiveWorkbook
sname = Sheet9.Range("I5") & "_" & _
Format(Sheet9.Range("I8"), "ddmmmyyyy") & ".xlsx"
relativepath = "C:\Users\" & Environ$("Username") & _
"\SharePoint\Open Project Transition Check - Doc\Transition Dashboard Report\" & sname 'use path of wbSource
'wbDest.Sheets(1).Range("A1").Clear 'clear filename from new workbook cell A1
Application.DisplayAlerts = False
ActiveWorkbook.CheckCompatibility = False
ActiveWorkbook.SaveAs Filename:=relativepath, FileFormat:=xlOpenXMLWorkbook, _
CreateBackup:=False
Application.DisplayAlerts = True
wbDest.Close False 'close the newly saved workbook without saving (we already saved)
'Next
MsgBox "DashBoard Report Saved!"
End Sub
Greatly appreciate anyone who could assist me. Thanks.
I wish I could give a definitive answer, or Microsoft would contribute.
I have similar connected problems. It seems that another version of the file may be or "appear to be" open elsewhere, thus preventing excel/Onedrive from completing the save action.
Rather than overwrite it(lets face t, that was the command) it creates a "version" filename(1).
I am guessing this is the same as when you do it manually and you are asked to resolve a conflict.
So far I have failed to find out how you can discover and solve the problem in code.
I solved it in one instance by mapping a drive on the offending desktop and first closing any open versions before save, but that is not a robust long term solution.
Test this by setting Application.DisplayAlerts = True and capturing errors.
"On error got catch" after the last dimension line then
"exit function
catch:
msgbox err.description"
before "end sub"

Looping through opened workbooks

i have managed to get a code which opens all files existing in a folder. now i want to run a macro(Called as donemovementReport) on these files one by one like as it runs on
one i save the file then run on the next one.
The Macro donemovementreport pastes all data from these open sheets to a template. i want to save this tamplate not the opened workbook which carries the actual data.
anybody with some idea?
Sub OpenAllWorkbooks()
Set destWB = ActiveWorkbook
Dim DestCell As Range
FileNames = Application.GetOpenFilename( _
filefilter:="Excel Files (*.csv*),*.csv*", _
Title:="Select the workbooks to load.", MultiSelect:=True)
If IsArray(FileNames) = False Then
If FileNames = False Then
Exit Sub
End If
End If
For n = LBound(FileNames) To UBound(FileNames)
Set wb = Workbooks.Open(fileName:=FileNames(n), ReadOnly:=True)
Next n
'Dim i As Integer
'i = ActiveWorkbook.AcceptAllChanges
'For i = 1 To ActiveWorkbook
Call donemovementReport
'Next i
End Sub
If I understand the input correctly, you need to loop through ALL opened workbooks. This may be achieved using Workbooks collection. Use this piece of code for that:
Dim wb As Workbook
For Each wb In Workbooks
wb.AcceptAllChanges
Call donemovementReport
Next wb
Modify the code between For...Next as you wish or provide more input.
Read more about referencing to workbooks in VBA: http://www.techrepublic.com/blog/10things/10-ways-to-reference-excel-workbooks-and-sheets-using-vba/967 (the above code is item 3 of 10 listed there).

Resources