How to use VBA SaveAs without closing calling workbook?
Here is a much faster method than using .SaveCopyAs
to create a copy an then open that copy and do a save as...
As mentioned in my comments, this process takes approx 1 second to create an xlsx copy from a workbook which has 10 worksheets (Each with 100 rows * 20 Cols of data)
Sub Sample() Dim thisWb As Workbook, wbTemp As Workbook Dim ws As Worksheet On Error GoTo Whoa Application.DisplayAlerts = False Set thisWb = ThisWorkbook Set wbTemp = Workbooks.Add On Error Resume Next For Each ws In wbTemp.Worksheets ws.Delete Next On Error GoTo 0 For Each ws In thisWb.Sheets ws.Copy After:=wbTemp.Sheets(1) Next wbTemp.Sheets(1).Delete wbTemp.SaveAs "C:\Blah Blah.xlsx", 51LetsContinue: Application.DisplayAlerts = True Exit SubWhoa: MsgBox Err.Description Resume LetsContinueEnd Sub
I did something similar to what Siddharth suggested and wrote a function to do it as well as handle some of the annoyances and offer some more flexibility.
Sub saveExample() Application.ScreenUpdating = False mySaveCopyAs ThisWorkbook, "C:\Temp\testfile2", xlOpenXMLWorkbook Application.ScreenUpdating = TrueEnd SubPrivate Function mySaveCopyAs(pWorkbookToBeSaved As Workbook, pNewFileName As String, pFileFormat As XlFileFormat) As Boolean 'returns false on errors On Error GoTo errHandler If pFileFormat = xlOpenXMLWorkbookMacroEnabled Then 'no macros can be saved on this mySaveCopyAs = False Exit Function End If 'create new workbook Dim mSaveWorkbook As Workbook Set mSaveWorkbook = Workbooks.Add Dim initialSheets As Integer initialSheets = mSaveWorkbook.Sheets.Count 'note: sheet names will be 'Sheet1 (2)' in copy otherwise if 'they are not renamed Dim sheetNames() As String Dim activeSheetIndex As Integer activeSheetIndex = pWorkbookToBeSaved.ActiveSheet.Index Dim i As Integer 'copy each sheet For i = 1 To pWorkbookToBeSaved.Sheets.Count pWorkbookToBeSaved.Sheets(i).Copy After:=mSaveWorkbook.Sheets(mSaveWorkbook.Sheets.Count) ReDim Preserve sheetNames(1 To i) As String sheetNames(i) = pWorkbookToBeSaved.Sheets(i).Name Next i 'clear sheets from new workbook Application.DisplayAlerts = False For i = 1 To initialSheets mSaveWorkbook.Sheets(1).Delete Next i 'rename stuff For i = 1 To UBound(sheetNames) mSaveWorkbook.Sheets(i).Name = sheetNames(i) Next i 'reset view mSaveWorkbook.Sheets(activeSheetIndex).Activate 'save and close mSaveWorkbook.SaveAs FileName:=pNewFileName, FileFormat:=pFileFormat, CreateBackup:=False mSaveWorkbook.Close mySaveCopyAs = True Application.DisplayAlerts = True Exit FunctionerrHandler: 'whatever else you want to do with error handling mySaveCopyAs = False Exit FunctionEnd Function
There is nothing pretty or nice about this process in Excel VBA, but something like the below.This code doesn't handle errors very well, is ugly, but should work.
We copy the workbook, open and resave the copy, then delete the copy. The temporary copy is stored in your local temp directory, and deleted from there as well.
Option ExplicitPrivate Declare Function GetTempPath Lib "kernel32" _ Alias "GetTempPathA" (ByVal nBufferLength As Long, _ ByVal lpBuffer As String) As LongPublic Sub SaveCopyAs(TargetBook As Workbook, Filename, FileFormat, CreateBackup) Dim sTempPath As String * 512 Dim lPathLength As Long Dim sFileName As String Dim TempBook As Workbook Dim bOldDisplayAlerts As Boolean bOldDisplayAlerts = Application.DisplayAlerts Application.DisplayAlerts = False lPathLength = GetTempPath(512, sTempPath) sFileName = Left$(sTempPath, lPathLength) & "tempDelete_" & TargetBook.Name TargetBook.SaveCopyAs sFileName Set TempBook = Application.Workbooks.Open(sFileName) TempBook.SaveAs Filename, FileFormat, CreateBackup:=CreateBackup TempBook.Close False Kill sFileName Application.DisplayAlerts = bOldDisplayAlertsEnd Sub