How to use VBA SaveAs without closing calling workbook? How to use VBA SaveAs without closing calling workbook? vba vba

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