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

时间:2016-09-12 19:18:08

标签: excel vba excel-2010

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

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

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

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

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

我注意到的一些事情:

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

    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
    

2 个答案:

答案 0 :(得分:2)

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

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

oEmbFile.Object.SaveAs fName

然后,您可以跳过与在当前Excel服务器中找到它相关的其他体操。

答案 1 :(得分:1)

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

更新了代码/解释:

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