How to use VBA SaveAs without closing calling workbook?

Question

I want to:

• Do data manipulation using a Template workbook
• Save a copy of this work book as .xlsx (SaveCopyAs doesn\'t let you change filetypes, otherw

Answer 1

Another option (only tested on latest versions of excel).

The Macros are not deleted until the workbook is closed after a SaveAs .xlsx so you can do two SaveAs in quick succession without closing the workbook.

ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False, ConflictResolution:=xlLocalSessionChanges
Application.DisplayAlerts = True

Note: you need to turn off the DisplayAlerts to avoid getting the warning that the workbook already exists on the second save.

Answer 2

I have a similar process, here's the solution I use. It allows the user to open a template, perform manipulation, save the template somewhere, and then have the original template open

1. user opens macro-enabled template file
2. do manipulation
3. save ActiveWorkbook's file path (template file)
4. execute a SaveAs
5. set ActiveWorkbook (now the saveas'd file) as a variable
6. open template file path in step 3
7. close the variable in step 5

the code looks something like this:

    'stores file path of activeworkbook BEFORE the SaveAs is executed
    getExprterFilePath = Application.ActiveWorkbook.FullName

    'executes a SaveAs
    ActiveWorkbook.SaveAs Filename:=filepathHere, _
    FileFormat:=51, _
    Password:="", _
    WriteResPassword:="", _
    ReadOnlyRecommended:=False, _
    CreateBackup:=False

    'reenables alerts
    Application.DisplayAlerts = True


    'announces completion to user
    MsgBox "Export Complete", vbOKOnly, "List Exporter"             


    'sets open file (newly created file) as variable
    Set wbBLE = ActiveWorkbook

    'opens original template file
    Workbooks.Open (getExprterFilePath)

    'turns screen updating, calculation, and events back on
    With Excel.Application
        .ScreenUpdating = True
        .Calculation = Excel.xlAutomatic
        .EnableEvents = True
    End With

    'closes saved export file
    wbBLE.Close

Answer 3

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 Explicit

Private Declare Function GetTempPath Lib "kernel32" _
         Alias "GetTempPathA" (ByVal nBufferLength As Long, _
         ByVal lpBuffer As String) As Long

Public 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 = bOldDisplayAlerts
End Sub

Answer 4

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 = True
End Sub

Private 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 Function

errHandler:
    'whatever else you want to do with error handling
    mySaveCopyAs = False
    Exit Function


End Function

Answer 5

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", 51

LetsContinue:
    Application.DisplayAlerts = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub