Extract embedded Excel worksheet data from Word

问题:

I have a batch of Word documents that have embedded Excel worksheets. Users have been entering data in the Excel sheet by double clicking the image of the sheet and opening an embedded Excel object. I need to get to the user entered data.

Below is WORD VBA with a reference to the Microsoft Excel 15 library. (The Word and Excel object where created under Office 2010.)

I can find the OLE object but I can't do anything with it. In the code below I tried to assign the object to a Worksheet object but I get a type mismatch error.

To complicate things further the embedded Excel sheet has macros. During some passes at the problem an Excel window opens with a prompt to enable macros security prompt. I can most likely temporarily disable macro checking to get past this.

All I need to do is get at the data in the worksheet to copy it elsewhere one time. I would be happy with just copying the worksheet to an external file if that is even possible.

I have Office 2010 and 2013, and Visual Studio 2010 Pro and 2014 Express at hand.

How can I get to the embedded worksheet data?

    Sub x()
        Dim oWS As Excel.Worksheet
        Dim oIShape As InlineShape
        For Each oIShape In ActiveDocument.InlineShapes
            If Not oIShape.OLEFormat Is Nothing Then
                 If InStr(1, oIShape.OLEFormat.ProgID, "Excel") Then
                    oIShape.OLEFormat.ActivateAs (oIShape.OLEFormat.ClassType) 'Excel.Sheet.8
                    Set oWS = oIShape  '** type mismatch
                    Debug.Print oWS.Cells(1, 1)
                End If
            End If
        Next oIShape
    End Sub

---

I used the suggested to get started on a previous try: Modify embedded Excel workbook in Word document via VBA

Had some problems with proper references and the code bungling up the document.

Below is another pass that works OK but has some issues and code I don't understand.

1) I don't want to use Edit mode but other modes didn't work 2) The immaculate reference Set xlApp = GetObject(, "Excel.Application") is strange. Some kind of undocumented feature?

    Sub TestMacro2()
        Dim lNumShapes As Long
        Dim lShapeCnt As Long
        Dim xlApp As Object
        Dim wrdActDoc As Document
        Dim iRow As Integer
        Dim iCol As Integer

        Set wrdActDoc = ActiveDocument
        For lShapeCnt = 1 To wrdActDoc.InlineShapes.Count
            If wrdActDoc.InlineShapes(lShapeCnt).Type = wdInlineShapeEmbeddedOLEObject Then
                If wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.ProgID = "Excel.Sheet.8" Then
                    wrdActDoc.InlineShapes(lShapeCnt).OLEFormat.Edit
                    Set xlApp = GetObject(, "Excel.Application")
                    With xlApp.Workbooks(1).Worksheets(2) ' can be multiple sheets, #2 is needed in this case
                        For iCol = 3 To .UsedRange.Columns.Count
                            If .Cells(1, iCol) = "" Then Exit For
                           For iRow = 1 To .UsedRange.Rows.Count
                                    Debug.Print .Cells(iRow, iCol) & "; ";
                            Next iRow
                            Debug.Print 'line feed
                        Next iCol
                    End With
                    xlApp.Workbooks(1).Close
                    xlApp.Quit
                    Set xlApp = Nothing
                End If
            End If
        Next lShapeCnt
    End Sub

Code works well enough to accomplish my extraction task - thanks!