如何在不关闭调用工作簿的情况下使用 VBA SaveAs？答案

【问题标题】：How to use VBA SaveAs without closing calling workbook?如何在不关闭调用工作簿的情况下使用 VBA SaveAs？
【发布时间】：2013-09-24 20:11:50
【问题描述】：

我想：

使用模板工作簿进行数据操作
将此工作簿的副本另存为 .xlsx（SaveCopyAs 不允许您更改文件类型，否则会很棒）
继续显示原始模板（不是“另存为”的模板）

使用SaveAs 完全符合预期 - 它在删除宏的同时保存工作簿并向我显示新创建的 SavedAs 工作簿的视图。

不幸的是，这意味着：

除非我重新打开启用宏的工作簿，否则我不再查看它
此时代码执行停止，因为
如果我忘记保存，任何宏更改都会被丢弃（注意：对于生产环境这没问题，但对于开发来说，这是一个巨大的痛苦）

有什么办法可以做到吗？

'current code
Application.DisplayAlerts = False
templateWb.SaveAs FileName:=savePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
templateWb.Activate
Application.DisplayAlerts = True

'I don't really want to make something like this work (this fails, anyways)
Dim myTempStr As String
myTempStr = ThisWorkbook.Path & "\" & ThisWorkbook.Name
ThisWorkbook.Save
templateWb.SaveAs FileName:=savePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
Workbooks.Open (myTempStr)

'I want to do something like:
templateWb.SaveCopyAs FileName:=savePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 'SaveCopyAs only takes one argument, that being FileName

另外请注意，虽然SaveCopyAs 可以让我将其另存为其他类型（即templateWb.SaveCopyAs FileName:="myXlsx.xlsx"），但打开它时会出现错误，因为它现在具有无效的文件格式。

【问题讨论】：

我能想到的一个蹩脚的解决方法是 SaveCopyAs，打开副本，将其保存为所需的格式，然后删除副本。如果你把它塞进一个子程序中，它就不会弄乱你的主程序。
使用SaveCopyAs 创建一个副本，然后打开该副本并另存为？
@Cor_Blimey：抱歉没有看到你的评论
或者创建一个新工作簿，将所有工作表复制到其中，然后将其保存为 xlsx？
这两个选项都让我在内心深处死去（好吧很多）。 @Cor_Blimey 我最初也确实想过这样做，但似乎应该有更好的方法。我正在使用网络驱动器，因此理想的做法是尽量减少对它们的多次节省。

标签： vba excel save

【解决方案1】：

另一个选项（仅在最新版本的 excel 上测试）。

在SaveAs .xlsx 之后关闭工作簿之前不会删除宏，因此您可以快速连续执行两个SaveAs 而无需关闭工作簿。

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

注意：您需要关闭DisplayAlerts，以避免在第二次保存时收到工作簿已存在的警告。

【讨论】：

【解决方案2】：

我有一个类似的过程，这是我使用的解决方案。它允许用户打开模板、执行操作、将模板保存在某处，然后打开原始模板

用户打开启用宏的模板文件
进行操作
保存ActiveWorkbook的文件路径（模板文件）
执行另存为
将 ActiveWorkbook（现在是 saveas'd 文件）设置为变量
在步骤 3 中打开模板文件路径
在步骤 5 中关闭变量

代码如下所示：

    '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

【讨论】：

【解决方案3】：

我做了类似于 Siddharth 建议的事情，并编写了一个函数来执行此操作，同时处理一些烦恼并提供更多灵活性。

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

【讨论】：

出于好奇，您是否有理由复制工作表而不将它们从临时文件中移出？移动会自动关闭工作簿。无论如何，我可以看到这比保存副本、打开等要快，但是如果您打算将此方法与带有表格、公式、定义名称等的工作表一起使用，它可能不会很好（尽管当您使用它时）你控制的模板，我想你知道这不是问题）。
@Cor_Blimey 我想保持模板完好无损，并基本上像“SaveCopyAs”一样使用此功能 - 如果我移动工作表，我会从模板工作簿中丢失它们。
哎呀——我忘记了那个目标。谢谢。

【解决方案4】：

这是一种比使用.SaveCopyAs 创建副本然后打开该副本并另存为更快的方法...

正如我在 cmets 中提到的，这个过程大约需要 1 秒来从一个有 10 个工作表（每个有 100 行 * 20 个数据列）的工作簿创建一个 xlsx 副本

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

【讨论】：

+1，这与我最终得到的 here 非常相似 - 我使它更健壮并成为一个函数。
另外For Each... ws.Delete 就是这样一个黑客;)
这取决于您使用的 Excel 版本。使用 Excel 2003 复制工作表不是安全操作，可能会导致数据丢失。
哦，是的，还有：Application.SheetsInNewWorkbook = 1 使您不必删除任意数量的工作表并在其中添加讨厌的 On Error Resume Next。您应该保存来自Application.SheetsInNewWorkbook 的值并在您的 Sub 结束时恢复它。
@SiddharthRout IIRC 可能会出现一些错误。例如，快速谷歌搜索出现the 255 character limit。

【解决方案5】：

在 Excel VBA 中，这个过程没有什么漂亮或好看的，但类似于下面的内容。这段代码不能很好地处理错误，很丑，但应该可以工作。

我们复制工作簿，打开并重新保存副本，然后删除副本。临时副本存储在您的本地临时目录中，也可以从那里删除。

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

【讨论】：