将嵌入的OLE对象（Excel工作簿）保存到Excel 2010中的文件

Question

我试图将当前/打开的工作簿中的嵌入式OLE对象（Excel工作簿）保存到用户PC上的某个位置。此OLE对象是在执行宏期间填充的模板/仪表板。

宏首先测试文件是否存在于用户的C盘上。

如果它确实存在，则会打开该文件并将工作簿变量设置为此新打开的工作簿。这适用于Excel 2010和Excel 2013。

如果用户没有将文件保存到其C驱动器，则宏将打开OLE对象以将其保存到驱动器。宏然后指回该位置并打开文件。该代码适用于Excel 2013，但在Excel 2010中，当我尝试将文件保存到驱动器时​​，宏崩溃了Excel。如果我在中断模式下运行宏，保存工作，只有在运行时才会发生崩溃。

是否可以使用DoEvents或Application.Wait？

我注意到的一些事情：

1. 崩溃不会生成任何错误代码。它只是给出了“已经停止响应”。
2. 我尝试过.SaveAs fileformat：= 52 vs .SaveCopyAs的多个版本。这两种方法在2010年都会产生同样的崩溃。
3. OLE对象打开为“Worksheet in”，如果在新工作簿中打开它将会很好。我认为这个崩溃可能与对象如何作为“工作表”而不是它自己的工作簿打开有关。

码：

Dim uName As String
Dim fName As String
Dim wbk As Workbook
Dim sumWB as Workbook
Dim cbrWB as Workbook

Set cbrWB = Workbooks("PreviouslySet")    

uName = Left(Environ("AppData"), Len(Environ("AppData")) - 16)
fName = uName & "\OTPReport"  & ".xlsm"

If Dir(fName) = "" Then

    Set oEmbFile = cbrWB.Worksheets("CBRDATA").OLEObjects("OTPReport")
    oEmbFile.Verb 0

    For Each wbk In Workbooks
        If InStr(1, wbk.Name, "Worksheet in", vbTextCompare) > 0 And InStr(1, wbk.Name, Left(cbrWB.Name, Round(Len(cbrWB.Name) / 2)), vbTextCompare) > 0 Then
            Set sumWB = Workbooks(wbk.Name)
        End If
    Next wbk

    With sumWB
        .Activate
        .Application.DisplayAlerts = False

        '==ISSUE EXISTS HERE==
        .SaveCopyAs (fName)

        .Close
    End With
    Set sumWB = Nothing
    Set sumWB = Workbooks.Open(fName)
Else:
    Set sumWB = Workbooks.Open(fName)
End If

Answer 1

使用实际嵌入的COM对象而不是.Verb 0为您提供的默认操作。

如果它们由COM服务器管理，它们会公开对底层对象的引用（它是.Object属性）。在您的情况下，由于您有一个嵌入式工作簿，它只是一个Workbook对象，就像您在VBA中遇到的任何其他Workbook对象一样。您需要做的就是在上面调用.SaveAs：

oEmbFile.Object.SaveAs fName

然后你可以简单地跳过与你当前的Excel服务器中找到它相关的其他体操。

Answer 2

在此处发布我的解决方案，以显示2010年和2013年似乎有效的方法。此解决方案是在用户COMIntern的帮助下开发的。我会赞同这个解决方案的答案。

更新的代码w /说明：

Dim uName As String
Dim fName As String

uName = Left(Environ("AppData"), Len(Environ("AppData")) - 16)
fName = uName & "\OTPReport" & ".xlsm"

If Dir(fName) = "" Then
    Set oEmbFile = cbrWB.Worksheets("CBRDATA").OLEObjects("OTPReport")
    oEmbFile.Object.SaveAs fName

    'For some reason a new workbook named "BookN" (n = to some integer) is created when 
    'saving our embedded file to C. To counter this, I close the most recently opened workbook.
    Workbooks(Workbooks.Count).Close

    'When opening this workbook, the file shows that it is opened, but the window is not activated. 
    'We must use the name of the file and call activate to get it to show up in our active windows.
    Set sumWB = Workbooks.Open(fName)
    Windows("OTPReport.xlsm").Activate
Else:
    'same explanation as above
    Set sumWB = Workbooks.Open(fName)
    Windows("OTPReport.xlsm").Activate
End If