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

Question

我想要：

• 使用模板工作簿进行数据操作
• 将此工作簿另存为 .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"），但打开时会出现错误，因为它现在具有无效的文件格式。

- enderland

---

我能想到的一个笨拙的解决方法是先进行SaveCopyAs操作，然后打开副本，将其另存为所需格式，最后删除该副本。如果你将它放入子程序中，那么它就不会混乱你的主要过程了。 - Cor_Blimey

使用 SaveCopyAs 创建一个副本，然后打开该副本并进行另存为操作？ - Siddharth Rout

@Cor_Blimey：抱歉，没看到你的评论。 - Siddharth Rout

@SiddharthRout 是的，我认为这可能是“最好的”（在这里非常宽泛地使用这个词...）。 - enderland

是的，它相对来说非常快。如果你遇到困难，告诉我，我会发布一个示例。 - Siddharth Rout

Answer 1

以下是比使用.SaveCopyAs方法创建副本并打开副本进行另存为更快的方法...

正如我在评论中提到的，此过程仅需大约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

- Siddharth Rout

---

+1，这与我最终得到的这里非常相似 - 我将其变得更加健壮并成为一个函数。 - enderland

另外，“For Each... ws.Delete” 这种写法也太巧妙了吧 ;) - enderland

还有一点：Application.SheetsInNewWorkbook = 1 可以避免您删除任意数量的工作表并在其中添加On Error Resume Next。 您应该保存Application.SheetsInNewWorkbook的值，并在子程序结束时恢复它。 - AndASM

如果我没记错的话，可能会出现一些错误。例如，快速搜索谷歌可以找到255个字符限制。 - AndASM

@AndASM：啊，我之前不知道那个问题。从来没有在单元格中输入过如此长的公式或文本 :P 今天学到了新东西。等我拿到Excel 2003就要测试一下。即使安装了SP3，这种情况还会发生吗？ - Siddharth Rout

Answer 2

我做了类似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

- enderland

---

出于好奇，您复制工作表而不是从临时文件中移动它们，有什么原因吗？移动会自动关闭工作簿。无论如何，我可以看到这比保存副本、打开等更快，但如果您打算在具有表格、公式、定义名称等的工作表中使用此方法，可能不是很好（尽管您正在使用模板，我想您知道这不是问题）。 - Cor_Blimey

@Cor_Blimey 我想保持模板不变，并基本上像“SaveCopyAs”一样使用此功能-如果我移动工作表，它们将从模板工作簿中丢失。 - enderland

糟糕 - 我忘记了那个目标。谢谢。 - Cor_Blimey

Answer 3

在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

- AndASM

Answer 4

我有一个类似的流程，这是我使用的解决方案。它允许用户打开模板，进行操作，将模板保存到某个地方，然后再打开原始模板。

1. 用户打开启用宏的模板文件
2. 执行操作
3. 保存ActiveWorkbook的文件路径（模板文件）
4. 执行SaveAs
5. 将ActiveWorkbook（现在是SaveAs的文件）设置为变量
6. 打开第3步中的模板文件路径
7. 关闭步骤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

- arbitel

Answer 5

另一个选项（仅在最新版本的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以避免在第二次保存时收到工作簿已存在的警告。

- OSKM

Answer 6

不错的解决方案@enderland。我想分享一下我的问题，有些微不同。我从Excel读取数据。对于Excel表中的每一行，我都会打开Word模板文档。然后将数据从Excel插入其中。然后将其保存到新的Word文档中，而不更改模板。当这些Word文档在运行宏时关闭时，它运行得很好。但是，当其中一些文档处于打开状态时，基本上无法保存任何内容。

我所做的是首先检查是否已经运行了某个Word应用程序，如果是，则使用它：

'Start Word and add a new document, but if word is already running use it
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
    Set wd = New Word.Application
End If

然后有一个帮助字符串变量"templFName"，基本上保存了单词模板文件的名称。为简单起见，我生成的所有输出Word文档都命名为：

templFName & "some unique suffix" & ".docx"

然后检查我使用的任何Word文档（模板或输出文档）是否已经打开，如果是，则关闭它（使用第一步中的引用）：

'close word document if already opened
Dim aDoc As Document
For Each aDoc In Documents
    If InStr(1, aDoc.Name, templFName, 1) Then
        aDoc.ActiveWindow.Close
        Set aDoc = Nothing
    End If
Next aDoc

然后退出 Word 应用程序并打开全新的应用程序：

wd.Quit
Set wd = Nothing
Set wd = New Word.Application

就是这样，最后一步解决了我的问题，在运行宏之前，确保所有输出的 Word 文档都没有打开。 希望有一天能帮到别人。祝您有美好的一天。

- 10101101