Link to home
Start Free TrialLog in
Avatar of PeterFrb
PeterFrbFlag for United States of America

asked on

Genericizing Open-Instance hunting in Excel or Access: late binding for Access instances?

My question is a followon to the superb answer I received on a previous question: https://www.experts-exchange.com/questions/27828791/VBA-vs-VB-Net-Net-not-returning-Excel-Objects.html.  The attached code from  Corey2 completely resolved my requirements, and I quickly realized the need to do the same thing for Access instances.  My existing code returns an array of all the running instances of Excel.  By parameterizing one or more key bits, the IID_IDispatch being the most obvious example, I'm sure I can genericize the functionality in short order to choose between an array of either Excel or Access applications.

Thanks for the excellent work, and I look forward to taking this to the next level.  For your conveience, I've included my top-level code block that, except for returning a viable list of open instances, is a verbatim copy of the previous submission.

~Peter Ferber

    Public Function Render_ExcelApps() As Microsoft.Office.Interop.Excel.Application()
        Dim Return_ExcelApps() As Microsoft.Office.Interop.Excel.Application

        Dim iCount As Integer

        iCount = -1
        Return_ExcelApps = Nothing
        For Each p As Process In Process.GetProcessesByName("Excel")
            Dim App As ExcelWindow
            Try
                ' Walk the children of this window to see if any are
                ' IAccessible.
                Dim hwnd As Integer = p.MainWindowHandle
                Dim hWndChild As Integer = 0
                Dim cb As EnumChildCallback = New EnumChildCallback(AddressOf EnumChildProc)
                EnumChildWindows(hwnd, cb, hWndChild)
                ' OBJID_NATIVEOM gets us a pointer to the native 
                ' object model.
                Dim OBJID_NATIVEOM As UInteger = CUInt("&HFFFFFFF0")
                Dim IID_IDispatch As Guid = GetType(Excel.Application).GUID
                IID_IDispatch = New Guid("{00020400-0000-0000-C000-000000000046}") '


                App = Nothing
                Dim hr As Integer = AccessibleObjectFromWindow(hWndChild, OBJID_NATIVEOM, IID_IDispatch.ToByteArray(), App)
                If (Not App Is Nothing) Then
                    iCount += 1
                    ReDim Preserve Return_ExcelApps(iCount)
                    Return_ExcelApps(iCount) = App.Application
                    '                    Debug.Print(hr)
                End If
            Catch ex As Exception

            End Try

        Next p
        Render_ExcelApps = Return_ExcelApps

    End Function

Open in new window

Avatar of Bob Learned
Bob Learned
Flag of United States of America image

1) The process name is different (MSACCESS instead of EXCEL)

2) The IDispatch ID is different

3) You have two ways of setting the IDispatch ID

 Dim IID_IDispatch As Guid = GetType(Excel.Application).GUID

    and

 IID_IDispatch = New Guid("{00020400-0000-0000-C000-000000000046}")

 The second one overrides the first one.  It would be good to know if the first one works, otherwise you would have to find the ID for Access.
Avatar of PeterFrb

ASKER

Using the first method of getting the ID, I will try  Dim IID_IDispatch As Guid = GetType(Access.Application).GUID, and see what I get.  I just noticed in the code uses both methods of getting the IID_IDispatch that you mention.  I suspect that only one is necessary, and the first one is the more robust and reliable.

Thanks for the tips.  I'll take a look and see if I can come up with the generic code I'm seeking.

Best, ~Peter Ferber
Guys,

I had attempted to do it using the class GUID however the object we are getting is actually one class up in the hierarchy.  So the correct one to use is
New Guid("{00020400-0000-0000-C000-000000000046}") nomatter what Office Application you are trying to connect to.

So I gave genericizing a shot however I don't know the correct OfficeWindowClass name or the correct OfficeWindowClass interface GUID to implement for Access, however I was able to get Word and Excel to work correctly.

The links in the remarks of the ExcelWindow and WordWindow are where I found the correct GUIDs and the OfficeWindowClass names come from the windows API documentation http://msdn.microsoft.com/en-us/library/windows/desktop/dd317978(v=vs.85).aspx

But I failed to find the equivalent documentation for Access

Here is what I have

Imports Microsoft.Office.Interop
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Globalization

Public Class Form1

    ''' <summary>
    ''' Interface definition for Excel.Window interface
    ''' </summary>
    ''' <remarks>Found GUID documented here http://msdn.microsoft.com/en-us/library/microsoft.office.interop.Excel.window.aspx</remarks>
    <Guid("00020893-0000-0000-C000-000000000046"), _
    InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
    Public Interface ExcelWindow
    End Interface


    ''' <summary>
    ''' Interface definition for Word.Window interface
    ''' </summary>
    ''' <remarks>Found GUID documented here http://msdn.microsoft.com/en-us/library/microsoft.office.interop.Word.window.aspx</remarks>
    <Guid("00020962-0000-0000-C000-000000000046"), _
    InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
    Public Interface WordWindow
    End Interface

    ''' <summary>
    ''' Interface definition for Access.Window interface
    ''' </summary>
    ''' <remarks>I CANNOT FIND THIS GUID</remarks>
    <Guid("00020905-9999-0000-C000-000000000046"), _
    InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
    Public Interface AccessWindow
    End Interface

    ''' <summary>
    ''' This class is needed as a workaround to http://support.microsoft.com/default.aspx?scid=kb;en-us;320369
    ''' Excel automation will fail with the follwoing error on systems with non-English regional settings:
    ''' "Old format or invalid type library. (Exception from HRESULT: 0x80028018 (TYPE_E_INVDATAREAD))" 
    ''' </summary>
    Class UILanguageHelper
        Implements IDisposable

        Private _currentCulture As CultureInfo

        Public Sub New()
            ' save current culture and set culture to en-US 
            _currentCulture = System.Threading.Thread.CurrentThread.CurrentCulture
            System.Threading.Thread.CurrentThread.CurrentCulture = New CultureInfo("en-US")
        End Sub

        Public Sub Dispose() Implements System.IDisposable.Dispose
            'reset to original culture 
            System.Threading.Thread.CurrentThread.CurrentCulture = _currentCulture
        End Sub

    End Class

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Private Shared Function FindWindow(ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
    End Function

    <DllImport("Oleacc.dll", EntryPoint:="AccessibleObjectFromWindow")> _
    Private Shared Function AccessibleExcelFromWindow(ByVal hwnd As Integer, ByVal dwObjectID As UInt32, ByVal riid() As Byte, ByRef ptr As ExcelWindow) As Integer
    End Function

    <DllImport("Oleacc.dll", EntryPoint:="AccessibleObjectFromWindow")> _
    Private Shared Function AccessibleWordFromWindow(ByVal hwnd As Integer, ByVal dwObjectID As UInt32, ByVal riid() As Byte, ByRef ptr As WordWindow) As Integer
    End Function
    <DllImport("Oleacc.dll", EntryPoint:="AccessibleObjectFromWindow")> _
    Private Shared Function AccessibleAccessFromWindow(ByVal hwnd As Integer, ByVal dwObjectID As UInt32, ByVal riid() As Byte, ByRef ptr As AccessWindow) As Integer
    End Function


    Public Delegate Function EnumChildCallback(ByVal hwnd As Integer, ByRef lParam As Integer) As Boolean

    <DllImport("User32.dll")> _
    Public Shared Function EnumChildWindows(ByVal hWndParent As Integer, ByVal lpEnumFunc As EnumChildCallback, ByRef lParam As Integer) As Boolean
    End Function

    <DllImport("User32.dll")> _
    Public Shared Function GetClassName(ByVal hWnd As Integer, ByVal lpClassName As StringBuilder, ByVal nMaxCount As Integer) As Integer
    End Function

    ' Callback passed to EnumChildWindows to find any window with the
    ' registered classname "paneClassDC" - this is the class name of
    ' PowerPoint's accessible document window.
    Public Function EnumChildProc(hwnd As Integer, ByRef lParam As Integer) As Boolean

        Dim windowClass As StringBuilder = New StringBuilder(128)
        GetClassName(hwnd, windowClass, 128)
        Debug.Print(windowClass.ToString)
        If windowClass.ToString().ToUpper = OfficeWindowClass.ToUpper Then
            lParam = hwnd
            Return False
        End If
        Return True
    End Function

    ''' <summary>
    ''' Name of the window class for the desired application as defined http://msdn.microsoft.com/en-us/library/windows/desktop/dd317978(v=vs.85).aspx
    ''' </summary>
    ''' <remarks></remarks>
    Private OfficeWindowClass As String

    Public Function Render_OfficeApps(Of T)() As T()
        Dim Return_OfficeApps() As T
        Dim type As Type = GetType(T)
        Dim ProcName As String

        Select Case type.FullName
            Case GetType(Microsoft.Office.Interop.Excel.Application).FullName
                ProcName = "Excel"
                OfficeWindowClass = "Excel7"
            Case GetType(Microsoft.Office.Interop.Access.Application).FullName
                ProcName = "Access"
                OfficeWindowClass = "I don't know what goes here"
            Case GetType(Microsoft.Office.Interop.Word.Application).FullName
                ProcName = "WinWord"
                OfficeWindowClass = "_WwG"
        End Select

        Dim iCount As Integer

        iCount = -1
        Return_OfficeApps = Nothing
        For Each p As Process In Process.GetProcessesByName(ProcName)
            Dim App As Object
            Try
                ' Walk the children of this window to see if any are
                ' IAccessible.
                Dim hwnd As Integer = p.MainWindowHandle
                Dim hWndChild As Integer = 0
                Dim cb As EnumChildCallback = New EnumChildCallback(AddressOf EnumChildProc)
                EnumChildWindows(hwnd, cb, hWndChild)
                ' OBJID_NATIVEOM gets us a pointer to the native 
                ' object model.
                Dim OBJID_NATIVEOM As UInteger = CUInt("&HFFFFFFF0")
                'this GUID is to an IDispatch interface (OfficeWindow class above)
                Dim IID_IDispatch As Guid = New Guid("{00020400-0000-0000-C000-000000000046}") '


                App = Nothing
                Dim hr As Integer
                'must have a separate implementation of Call to get each window type AccessibleObjectFromWindow
                Select Case type.FullName
                    Case GetType(Microsoft.Office.Interop.Excel.Application).FullName
                        hr = AccessibleExcelFromWindow(hWndChild, OBJID_NATIVEOM, IID_IDispatch.ToByteArray(), App)
                    Case GetType(Microsoft.Office.Interop.Access.Application).FullName
                        hr = AccessibleAccessFromWindow(hWndChild, OBJID_NATIVEOM, IID_IDispatch.ToByteArray(), App)
                    Case GetType(Microsoft.Office.Interop.Word.Application).FullName
                        hr = AccessibleWordFromWindow(hWndChild, OBJID_NATIVEOM, IID_IDispatch.ToByteArray(), App)
                End Select
                If (Not App Is Nothing) Then
                    iCount += 1
                    ReDim Preserve Return_OfficeApps(iCount)
                    Return_OfficeApps(iCount) = App.Application
                End If
            Catch ex As Exception

            End Try

        Next p
        Return Return_OfficeApps

    End Function


    Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click

        Dim Excels() As Excel.Application
        Excels = Render_OfficeApps(Of Excel.Application)()
        If Excels Is Nothing Then
            MsgBox("Excel wasn't found")
            Exit Sub
        End If
        For Each exl As Excel.Application In Excels
            Try
                MsgBox(exl.ActiveWorkbook.Name)
            Catch ex As Exception
                MsgBox(ex.Message)
            End Try

        Next

        Dim Words() As Word.Application
        Words = Render_OfficeApps(Of Word.Application)()
        If Words Is Nothing Then
            MsgBox("Word wasn't found")
            Exit Sub
        End If
        For Each wrd As Word.Application In Words
            Try
                MsgBox(wrd.ActiveDocument.Name)
            Catch ex As Exception
                MsgBox(ex.Message)
            End Try

        Next

    End Sub
End Class

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Corey Scheich
Corey Scheich
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
The first one does not work.  The second was clearly placed later, as an afterthought, upon the first method not working.  The first method, which produces a GUID value that is close to the one that wprked, does not yield any application objects when run as is.

According to my research,  

GetType(Excel.Application).GUID.ToString:
    "000208d5-0000-0000-c000-000000000046"

The value used:
    "00020400-0000-0000-C000-000000000046"

GetType(Access.Application).GUID.ToString:
    "68cce6c0-6129-101b-af4e-00aa003f0f07"

When I use the "GetType" function to derive the Access application, I come up with "Nothing" (no objects).  The Excel process works, and the "Object" type appears to have a wrapper over the Excel applications, but I am able to get to the data using this method.  I am left with two outstanding issues, the first having the obvious precedence.

1.

Get the proper GUID for Access applications.

2.

Get direct access to the applications that the object embeds.
Thanks, ~Peter Ferber

    Sub Main()
        Dim MyExcelApps() As Object
        Dim MyAccessApps() As Object

        MyExcelApps = Render_Applications("EXCEL")
        MyAccessApps = Render_Applications("MSACCESS")
    End Sub

    Public Function Render_Applications(ByVal strApplication As String) As Object()
        Dim Return_Applications() As Object
        Dim IID_IDispatch As Guid

        Dim iCount As Integer

        On Error GoTo Err
        iCount = -1
        Return_Applications = Nothing
        For Each p As Process In Process.GetProcessesByName(strApplication)
            Dim App As ExcelWindow
            ' Walk the children of this window to see if any are
            ' IAccessible.
            Dim hwnd As Integer = p.MainWindowHandle
            Dim hWndChild As Integer = 0
            Dim cb As EnumChildCallback = New EnumChildCallback(AddressOf EnumChildProc)
            EnumChildWindows(hwnd, cb, hWndChild)
            ' OBJID_NATIVEOM gets us a pointer to the native 
            ' object model.
            Dim OBJID_NATIVEOM As UInteger = CUInt("&HFFFFFFF0")
            Select Case strApplication
                Case "EXCEL"
                    IID_IDispatch = New Guid("{00020400-0000-0000-C000-000000000046}")
                Case "MSACCESS"
                    '******Fails to return Access objects*****
                    IID_IDispatch = GetType(Access.Application).GUID
            End Select

            App = Nothing
            Dim hr As Integer = AccessibleObjectFromWindow(hWndChild, OBJID_NATIVEOM, IID_IDispatch.ToByteArray(), App)
            If (Not App Is Nothing) Then
                iCount += 1
                ReDim Preserve Return_Applications(iCount)
                Return_Applications(iCount) = App.Application
                '                    Debug.Print(hr)
            End If
        Next p
        Render_Applications = Return_Applications

Func_End:
        Exit Function

Err:
        Select Case Err.Number
            Case Else
                Call PrintError(Err, "Render_Applications")
                Resume Func_End
                Resume
        End Select
    End Function

    Sub PrintError(ByRef MyErr As Microsoft.VisualBasic.ErrObject, ByRef strRoutine As String)
        Dim iReturn As Short

        iReturn = MsgBox("Error in " & strRoutine & ": " & Err.Number & " - " & Err.Description & ".  Continue?  Press ""No"" to stop and ""Cancel"" to Quit", MsgBoxStyle.YesNoCancel)
        If (iReturn = MsgBoxResult.Cancel) Then
            End
        ElseIf (iReturn = MsgBoxResult.No) Then
            Stop
        End If
    End Sub

Open in new window

00020400-0000-0000-C000-000000000046 = IDispatch interface's GUID all the Office applications use this interface so it is the only one that is necessary.  See my second post today there were many changes outside the method you posted which are necessary to get to the Access process.  The only value that needs to change between the applications is the name of the childclass in the enumchildproc method and the name of the office process to filter on.
Sorry, Corey2.  I must have been making my post while you were sending yours, which is why my comments refer to the post before yours.  

I'm going to replicate your code and start there.  I'm unclear as to the significance of the output you showed in a previous post, with the text that follows.  Can you explain that for me?  And yes, I understand that the interface's GUID is not pointing to a specific application, so it has generic functionality.  Thanks for that clarification.  The roles of the cast members are difficult to track.  

When this gets running, popping a champaign cork would be in order!  That moment is premature, as yet, but is approaching! :-)

EXCEL2
MsoCommandBar
MsoWorkPane
NUIPane
NetUIHWND
EXCEL2
...(etc.)

Open in new window

It is important to understand that in

           Dim cb As EnumChildCallback = New EnumChildCallback(AddressOf EnumChildProc)
            EnumChildWindows(hwnd, cb, hWndChild)

Open in new window


cb defines a method that the windows api calls to get your input on which child interface you want the handle of.  In this case cb is defined as

  ' Callback passed to EnumChildWindows to find any window with the
    ' registered classname "Excel7" - this is the class name of
    ' Excels accessible document window.
    Public Function EnumChildProc(hwnd As Integer, ByRef lParam As Integer) As Boolean

        Dim windowClass As StringBuilder = New StringBuilder(128)
        GetClassName(hwnd, windowClass, 128)
        Debug.Print(windowClass.ToString)
        If windowClass.ToString().ToUpper = OfficeWindowClass.ToUpper Then
            lParam = hwnd
            Return False
        End If
        Return True
    End Function

Open in new window


and is called many times by the EnumChildWindows method to allow you to identify which of the many child interfaces you want.  We are identifying the interface by it's class name and are comparing it to OfficeWindowClass which for excel is set to "Excel7".  The list is produced by the debug.print call which I recently moved outside the if statement so I could see the names of each class that  EnumChildWindows comes across.  The list you mentioned above comes from this debug print call.

What I was trying to say is if you set up the program to attach to access and have OfficeWindowClass set to "Empty" every child class will be printed and you will have a short list of 20 or so classes to set OfficeWindowClass to one by one until you successfully attach to the right one.  I would do it myself I just don't have the time right now.

Corey
No worries!  You've done an exceptional amount already.

I've replecated your entire code block, and changed "Access" to "MSAccess" as the ProcName.  This yields processes, but the function returns Nothing, returning neither of the two Access applications I have open.  

I feel the answer is extremely close.  I'll research on my end and post if I get the answer.  You definitely get the credit for this great work.

In gratitude, ~Peter Ferber
The solution above is practically perfect, with MSAccess taking the place of "Access" for the Access ProcName.  Although the program does not return Access objects to me, the fact that it succeeds in returning both Excel and Word Application objects identifies the process as fundamentally sound. (For all I know, I may have some setting in Access that keeps my objects from identifying themselves to the process.  I don't know.)  But this is a complete solution and of superior quality.  Top knotch!

~Peter