Solved

Upgrading VB6 to VB.Net: Replace VB6 API's and Hidden functions with VB.Net Upgrade?

Posted on 2016-08-12
8
63 Views
Last Modified: 2016-08-17
The following set of procedures is responsible for the very important work of establishing all of the open workbooks residing on a Windows machine at the time it's run.  Making this run required a confusing bit of copy-and-pasted code, and it uses messy APIs and the hidden function "strPtr" to do its work.  Visual Studio 2008 has the capacity to read a VB6 Visual Basic Project (*.vbp) and translate it to a VB.Net program.  However, the "strPtr" routine is not supported in 2008, and the error message suggests that .Net has upgraded its controls to accomplish what was previously an unstable set of instructions.  If such a thing exists, I would love to know about it.  The following returns an array of Excel.Application objects, having found and returned all of the open apps in the work environment.

Take note that the routine GetExcelObjectFromHwnd includes the "strPtr" function.  When converted from VB6 to VB.Net, .Net sends me the error message that "strPtr" is not supported.  Doing further research on this problem, I find this helpful message: "Many of the Windows API calls that were necessary in Visual Basic 6.0 are now encapsulated in the .NET Framework; pointer references are no longer necessary."  I would be overjoyed to find out this is the case.  The functionality I'm seeking is akin to both the "Windows Task Manager" and the Windows Task Bar, shown in most Windows machines as a vertical or horizontal stripe that shows the icons of all the running applications.  If I had this visibility, I could quickly isolate all the running applications of a particular type, be it Excel, Access, or anything else that is currently open.  And I have little doubt the code would be both a percent or two in size of what's written below AND more robust.  

Knowing the tremendous overhaul that Microsoft put into the .Net engine, I would like to get entirely out of the business of using API and hidden calls, and this is a prime spot for their banishment.  

Sincerely, ~ Peter Ferber
 

Private Type UUID 'GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte
End Type

Private Declare Function FindWindowEx Lib "User32" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "User32" Alias "GetClassNameA" ( _
    ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long

Function RetrieveExcelApps() As Excel.Application()
    Dim TestApp As Excel.Application
    Dim ReturnApps() As Excel.Application
    
    Dim iCount As Integer
    
    On Error GoTo MyErrorHandler

    Dim hWndMain As Long
    hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
    iCount = -1
    If (hWndMain <> 0) Then
        Do While (hWndMain <> 0)
            Set TestApp = GetWbkWindows(hWndMain)
            If (Not TestApp Is Nothing) Then
                iCount = iCount + 1
                ReDim Preserve ReturnApps(iCount)
                Set ReturnApps(iCount) = GetWbkWindows(hWndMain)
            End If
            hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString)
        Loop
    End If
    RetrieveExcelApps = ReturnApps
Func_Exit:
    Exit Function

MyErrorHandler:
    Select Case Err.Number
        Case Else:
            Call MyUniversal_V2Class.PrintError(Err, "RetrieveExcelApps")
            Resume Func_Exit
            Resume
    End Select
End Function

Private Function GetWbkWindows(ByVal hWndMain As Long) As Excel.Application
    On Error GoTo MyErrorHandler

    Dim hWndDesk As Long
    hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString)

    Set GetWbkWindows = Nothing
    If hWndDesk <> 0 Then
        Dim hWnd As Long
        hWnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString)

        Dim strText As String
        Dim lngRet As Long
        Do While hWnd <> 0
            strText = String$(100, Chr$(0))
            lngRet = GetClassName(hWnd, strText, 100)

            If Left$(strText, lngRet) = "EXCEL7" Then
                Set GetWbkWindows = GetExcelObjectFromHwnd(hWnd)
                Exit Function
            End If

            hWnd = FindWindowEx(hWndDesk, hWnd, vbNullString, vbNullString)
        Loop

        On Error Resume Next
    End If

    Exit Function

MyErrorHandler:
    MsgBox "GetWbkWindows" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description
End Function

Public Function GetExcelObjectFromHwnd(ByVal hWnd As Long) As Excel.Application
    On Error GoTo MyErrorHandler

    Dim fOk As Boolean
    fOk = False

    Dim iid As UUID
    Call IIDFromString(StrPtr(IID_IDispatch), iid)

    Dim obj As Object
    If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK
        Set GetExcelObjectFromHwnd = obj.Application
        fOk = True
    End If

    'GetExcelObjectFromHwnd = fOk

Func_Exit:
    Exit Function

MyErrorHandler:
    Select Case Err.Number
        Case Else:
            Call MyUniversal_V2Class.PrintError(Err, "GetExcelObjectFromHwnd")
            Resume Func_Exit
            Resume
    End Select
End Function

Open in new window

0
Comment
Question by:PeterFrb
  • 4
  • 3
8 Comments
 
LVL 12

Expert Comment

by:funwithdotnet
ID: 41754600
Good for you! Welcome to the dark side. We have cookies!

I believe that Process.GetProcesses is where you'll find all the running apps.

I found the project converter you mentioned was only good for showing what a VB.NET version of that code would look like. Learn how to do what you want using .NET and you will not regret it.

Good luck!
0
 

Author Comment

by:PeterFrb
ID: 41754937
I did some research into using GetProcesses, and what you provided starts but not finish the conversation.

Running this code snippet yields an array of Processes objects that show all open Excel files.

        ' Get all processes running on the local computer.
        Dim localAll As Process() = Process.GetProcesses()

        ' Get all instances of Excel running on the local computer.
        ' This will return an empty array if notepad isn't running.
        Dim localByName As Process() = Process.GetProcessesByName("Excel")

Open in new window


This gives me a Windows handle to the Excel files that are open, but the key question is how to translate, without using API, the System.Diagnostic.Process into an Excel Application object.  The gnarlier, Dark Side-ier parts of the API-laden code, which I've demonstrated above, performs this magic.  To reach home plate, I want to do that using the .Net infrastructure, and not API calls.

Thanks, ~Peter
0
 
LVL 32

Assisted Solution

by:it_saige
it_saige earned 500 total points
ID: 41756621
While it is true that much of the API has been wrapped into the .NET framework, not all of it has.  You will find that it is not uncommon for some usage of the API to occur.

That being said we can easily build a wrapper class that presents a list of running Excel instances:
'' Based on code by JamesFaix - http://www.codeproject.com/Tips/1080611/Get-a-Collection-of-All-Running-Excel-Instances 
Class ExcelApplications
	Inherits List(Of Excel.Application)
	Private ReadOnly rrid As New Guid("{00020400-0000-0000-C000-000000000046}")

	Private Const MarshalName As String = "Excel.Application"
	Private Const ProcessName As String = "EXCEL"
	Private Const ComClassName As String = "EXCEL7"
	Private Const DW_OBJECTID As UInt32 = &HFFFFFFF0UI
	Private Const GW_HWNDPREV As UInt32 = 3

	Public Sub New()
		MyBase.New()
		FillList()
	End Sub

	Public Sub New(capacity As Integer)
		MyBase.New(capacity)
		FillList()
	End Sub

	Public Sub New(collection As IEnumerable(Of Excel.Application))
		MyBase.New(collection)
		FillList()
	End Sub

	Public Sub FillList()
		AddRange(From [process] In GetProcesses()
			    Let application = FromProcess([process])
			    Where application IsNot Nothing AndAlso Not Contains(application)
			    Select application)
	End Sub

	Private Function FromProcess([process] As Process) As Excel.Application
		Try
			If [process] IsNot Nothing Then
				Return InnerFromProcess([process])
			End If
		Catch ex As Exception
			Return Nothing
		End Try
	End Function

	Public ReadOnly Property PrimaryInstance() As Excel.Application
		Get
			Try
				Return CType(Marshal.GetActiveObject(MarshalName), Excel.Application)
			Catch ex As Exception
				Return Nothing
			End Try
		End Get
	End Property

	Public ReadOnly Property TopMostInstance() As Excel.Application
		Get
			Try
				Return (From [application] In Me
					   Let ZAxis = GetWindowZ([application].Hwnd)
					   Where ZAxis > 0
					   Order By ZAxis
					   Select [application]).FirstOrDefault()
			Catch ex As Exception
				Return Nothing
			End Try
		End Get
	End Property

	Public Function GetProcesses() As IEnumerable(Of Process)
		Return Process.GetProcessesByName(ProcessName)
	End Function

	Private Function InnerFromProcess([process] As Process) As Excel.Application
		Return InnerFromHandle(ChildHandleFromMainHandle([process].MainWindowHandle))
	End Function

	Private Function ChildHandleFromMainHandle(handle As IntPtr) As IntPtr
		Dim childHandle As IntPtr = 0
		EnumChildWindows(handle, AddressOf EnumChildFunction, childHandle)
		Return childHandle
	End Function

	Private Function InnerFromHandle(handle As IntPtr) As Excel.Application
		Dim window As Excel.Window = Nothing
		Dim result = AccessibleObjectFromWindow(handle, DW_OBJECTID, rrid, window)
		Return window.Application
	End Function

	Private Function GetWindowZ(handle As IntPtr) As Integer
		Dim z = 0
		Dim h As IntPtr = handle
		While h <> IntPtr.Zero
			z += 1
			h = GetWindow(h, GW_HWNDPREV)
		End While
		Return z
	End Function

	Private Shared Function EnumChildFunction(hwndChild As Int32, ByRef lParam As Int32) As Boolean
		Dim buffer = New StringBuilder(128)
		GetClassName(hwndChild, buffer, 128)
		If buffer.ToString() = ComClassName Then
			lParam = hwndChild
			Return False
		End If
		Return True
	End Function

	<DllImport("oleacc.dll")> _
	Private Shared Function AccessibleObjectFromWindow(hwnd As IntPtr, id As UInteger, iid As Guid, <MarshalAs(UnmanagedType.IUnknown)> ByRef ppvObject As Object) As Integer
	End Function
	<DllImport("User32.dll")> _
	Private Shared Function EnumChildWindows(hWndParent As Int32, lpEnumFunc As EnumChildCallback, ByRef lParam As Int32) As [Boolean]
	End Function
	<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
	Private Shared Function GetClassName(hWnd As IntPtr, lpClassName As StringBuilder, nMaxCount As Integer) As Integer
	End Function
	<DllImport("User32.dll")> _
	Private Shared Function GetWindow(hWnd As IntPtr, uCmd As UInt32) As IntPtr
	End Function

	Private Delegate Function EnumChildCallback(hwnd As Int32, ByRef lParam As Int32) As [Boolean]
End Class

Open in new window

Example usage -

Form1.vb -
Imports System.Runtime.InteropServices
Imports System.Text

Public Class Form1
	Private Sub OnClick(sender As Object, e As EventArgs) Handles Button1.Click
		Dim applications As New ExcelApplications()
		Label1.Text = String.Format("Total Excel Instances Running: {0}", applications.Count)
		Label2.Text = String.Format("Total Excel Workbooks: {0}", (From [application] In applications Select [application].Workbooks.Count).Sum())
		Label3.Text = String.Format("Total Excel Worksheets: {0}", (From [application] In applications Select [application].Worksheets.Count).Sum())
		Label4.Text = String.Format("Workbook Names:{0}{1}", Environment.NewLine, String.Join(Environment.NewLine, (From [application] As Excel.Application In applications
																							   From [workbook] As Excel.Workbook In [application].Workbooks
																							   Select [workbook].FullName)))
		Label5.Text = String.Format("Worksheet Names:{0}{1}", Environment.NewLine, String.Join(Environment.NewLine, (From [application] As Excel.Application In applications
																							    From [worksheet] As Excel.Worksheet In [application].Worksheets
																							    Select [worksheet].Name)))
	End Sub
End Class

Open in new window

Form1.Designer.vb -
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class Form1
    Inherits System.Windows.Forms.Form

    'Form overrides dispose to clean up the component list.
    <System.Diagnostics.DebuggerNonUserCode()> _
    Protected Overrides Sub Dispose(ByVal disposing As Boolean)
        Try
            If disposing AndAlso components IsNot Nothing Then
                components.Dispose()
            End If
        Finally
            MyBase.Dispose(disposing)
        End Try
    End Sub

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> _
    Private Sub InitializeComponent()
		Me.Button1 = New System.Windows.Forms.Button()
		Me.Label1 = New System.Windows.Forms.Label()
		Me.Label2 = New System.Windows.Forms.Label()
		Me.Label3 = New System.Windows.Forms.Label()
		Me.Label4 = New System.Windows.Forms.Label()
		Me.Label5 = New System.Windows.Forms.Label()
		Me.SuspendLayout()
		'
		'Button1
		'
		Me.Button1.Location = New System.Drawing.Point(12, 12)
		Me.Button1.Name = "Button1"
		Me.Button1.Size = New System.Drawing.Size(260, 29)
		Me.Button1.TabIndex = 1
		Me.Button1.Text = "Get Excel Windows"
		Me.Button1.UseVisualStyleBackColor = True
		'
		'Label1
		'
		Me.Label1.AutoSize = True
		Me.Label1.Location = New System.Drawing.Point(13, 48)
		Me.Label1.Name = "Label1"
		Me.Label1.Size = New System.Drawing.Size(158, 13)
		Me.Label1.TabIndex = 2
		Me.Label1.Text = "Total Excel Instances Running: "
		'
		'Label2
		'
		Me.Label2.AutoSize = True
		Me.Label2.Location = New System.Drawing.Point(13, 74)
		Me.Label2.Name = "Label2"
		Me.Label2.Size = New System.Drawing.Size(121, 13)
		Me.Label2.TabIndex = 4
		Me.Label2.Text = "Total Workbooks Open:"
		'
		'Label3
		'
		Me.Label3.AutoSize = True
		Me.Label3.Location = New System.Drawing.Point(13, 100)
		Me.Label3.Name = "Label3"
		Me.Label3.Size = New System.Drawing.Size(123, 13)
		Me.Label3.TabIndex = 6
		Me.Label3.Text = "Total Worksheets Open:"
		'
		'Label4
		'
		Me.Label4.AutoSize = True
		Me.Label4.Location = New System.Drawing.Point(13, 126)
		Me.Label4.Name = "Label4"
		Me.Label4.Size = New System.Drawing.Size(96, 13)
		Me.Label4.TabIndex = 8
		Me.Label4.Text = "Workbook Names:"
		'
		'Label5
		'
		Me.Label5.AutoSize = True
		Me.Label5.Location = New System.Drawing.Point(13, 214)
		Me.Label5.Name = "Label5"
		Me.Label5.Size = New System.Drawing.Size(98, 13)
		Me.Label5.TabIndex = 9
		Me.Label5.Text = "Worksheet Names:"
		'
		'Form1
		'
		Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
		Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
		Me.ClientSize = New System.Drawing.Size(284, 356)
		Me.Controls.Add(Me.Label5)
		Me.Controls.Add(Me.Label4)
		Me.Controls.Add(Me.Label3)
		Me.Controls.Add(Me.Label2)
		Me.Controls.Add(Me.Label1)
		Me.Controls.Add(Me.Button1)
		Me.Name = "Form1"
		Me.Text = "Form1"
		Me.ResumeLayout(False)
		Me.PerformLayout()

	End Sub
	Friend WithEvents Button1 As System.Windows.Forms.Button
	Friend WithEvents Label1 As System.Windows.Forms.Label
	Friend WithEvents Label2 As System.Windows.Forms.Label
	Friend WithEvents Label3 As System.Windows.Forms.Label
	Friend WithEvents Label4 As System.Windows.Forms.Label
	Friend WithEvents Label5 As System.Windows.Forms.Label

End Class

Open in new window

Produces the following output -Capture.JPG-saige-
0
 

Author Comment

by:PeterFrb
ID: 41756953
Wow!  I am duly impressed!  

What version of Visual Studio are you using?  I have 2008, 2010, and 2012.  

Using Visual Studio 2010, I added a couple of "Import" lines, getting this down to 1 error.  In the property TopMostInstance, I see the error "'Hwnd' is not a member of 'Excel_Applications.Excel.Application'."  When I look for "Hwnd" in the object browser, I see "Microsoft.Office.Interop.Excel._Application.Hwnd As Integer": Any idea why there is an unexplained underscore in front of the word "Application"?  Also, in InnerFromHandle, I changed your Excel.Window to "Microsoft.Vbe.Interop.Window", which appeared to work in that context.

I am not familiar with the syntax of "Return (from [Application] in Me...", and I'm even having trouble finding that syntax documented.  The code is clearly following the syntax of a SQL statement, with a "Where", "Order By" and "Select" clause.  Would be interested to hear a little more about this routine and its function.

Seriously, I can't thank you enough.  This is a great leap forward, and it demonstrates the effective use of creating wrappers, leaving the consumer with only user-friendly functionality.  Solving for the one outstanding error, I will commence to testing the code functionality.  

And a bonus question: can you tell me what changes I would need to make to return all the open MS ACCESS applications?

Sincerely, ~ Peter Ferber

Option Strict Off

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

'' Based on code by JamesFaix - http://www.codeproject.com/Tips/1080611/Get-a-Collection-of-All-Running-Excel-Instances 
Class ExcelApplications
    Inherits List(Of Excel.Application)
    Private ReadOnly rrid As New Guid("{00020400-0000-0000-C000-000000000046}")

    Private Const MarshalName As String = "Excel.Application"
    Private Const ProcessName As String = "EXCEL"
    Private Const ComClassName As String = "EXCEL7"
    Private Const DW_OBJECTID As UInt32 = &HFFFFFFF0UI
    Private Const GW_HWNDPREV As UInt32 = 3

    Public Sub New()
        MyBase.New()
        FillList()
    End Sub

    Public Sub New(capacity As Integer)
        MyBase.New(capacity)
        FillList()
    End Sub

    Public Sub New(collection As IEnumerable(Of Excel.Application))
        MyBase.New(collection)
        FillList()
    End Sub

    Public Sub FillList()
        AddRange(From [process] In GetProcesses()
             Let application = FromProcess([process])
             Where application IsNot Nothing AndAlso Not Contains(application)
             Select application)
    End Sub

    Private Function FromProcess([process] As Process) As Excel.Application
        FromProcess = Nothing
        Try
            If [process] IsNot Nothing Then
                Return InnerFromProcess([process])
            End If
        Catch ex As Exception
            Return Nothing
        End Try
    End Function

    Public ReadOnly Property PrimaryInstance() As Excel.Application
        Get
            Try
                Return CType(Marshal.GetActiveObject(MarshalName), Excel.Application)
            Catch ex As Exception
                Return Nothing
            End Try
        End Get
    End Property

    Public ReadOnly Property TopMostInstance() As Excel.Application
        Get
            Try
                'Hwnd' is not Aggregate member of 'Excel_Aplications.Excel.Application'."
                Return (From [application] In Me
                    Let ZAxis = GetWindowZ([application].Hwnd)
                    Where ZAxis > 0
                    Order By ZAxis
                    Select [application]).FirstOrDefault()
            Catch ex As Exception
                Return Nothing
            End Try
        End Get
    End Property

    Public Function GetProcesses() As IEnumerable(Of Process)
        Return Process.GetProcessesByName(ProcessName)
    End Function

    Private Function InnerFromProcess([process] As Process) As Excel.Application
        Return InnerFromHandle(ChildHandleFromMainHandle([process].MainWindowHandle))
    End Function

    Private Function ChildHandleFromMainHandle(handle As IntPtr) As IntPtr
        Dim childHandle As IntPtr = 0
        EnumChildWindows(handle, AddressOf EnumChildFunction, childHandle)
        Return childHandle
    End Function

    Private Function InnerFromHandle(handle As IntPtr) As Excel.Application
        '"Type 'Excel.Window' is not defined.": changed to "Microsoft.Vbe.Interop.Window"
        Dim window As Microsoft.Office.Interop.Excel.Window = Nothing
        Dim result = AccessibleObjectFromWindow(handle, DW_OBJECTID, rrid, window)
        Return window.Application
    End Function

    Private Function GetWindowZ(handle As IntPtr) As Integer
        Dim z = 0
        Dim h As IntPtr = handle
        While h <> IntPtr.Zero
            z += 1
            h = GetWindow(h, GW_HWNDPREV)
        End While
        Return z
    End Function

    Private Shared Function EnumChildFunction(hwndChild As Int32, ByRef lParam As Int32) As Boolean
        Dim buffer = New StringBuilder(128)
        GetClassName(hwndChild, buffer, 128)
        If buffer.ToString() = ComClassName Then
            lParam = hwndChild
            Return False
        End If
        Return True
    End Function

    <DllImport("oleacc.dll")> _
    Private Shared Function AccessibleObjectFromWindow(hwnd As IntPtr, id As UInteger, iid As Guid, <MarshalAs(UnmanagedType.IUnknown)> ByRef ppvObject As Object) As Integer
    End Function
    <DllImport("User32.dll")> _
    Private Shared Function EnumChildWindows(hWndParent As Int32, lpEnumFunc As EnumChildCallback, ByRef lParam As Int32) As [Boolean]
    End Function
    <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
    Private Shared Function GetClassName(hWnd As IntPtr, lpClassName As StringBuilder, nMaxCount As Integer) As Integer
    End Function
    <DllImport("User32.dll")> _
    Private Shared Function GetWindow(hWnd As IntPtr, uCmd As UInt32) As IntPtr
    End Function

    Private Delegate Function EnumChildCallback(hwnd As Int32, ByRef lParam As Int32) As [Boolean]
End Class

Open in new window

0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 32

Assisted Solution

by:it_saige
it_saige earned 500 total points
ID: 41758620
This project was built using VS 2013.  But I do not believe that that is the issue.  I believe the issue you are having stems from the Office Interop version used.

In the project I have, I am referencing the Microsoft Office 14.0 Object Libraries.

As for the "Return (From [Application] in Me..." syntax; you are correct, it is very SQL like.  The terms/verbs and their inclusion into the language were introduced with .NET 3.5 as LINQ or Language INtegrated Query.

The particular form that I demontrated here is the expression (or query) syntax form; there is also the extension method syntax form.  These are really just syntactic sugar as the compiler generates each into an explicit method syntax; e.g. -
Module Module1
	ReadOnly numbers As Integer() = {6, 5, 7, 4, 8, 3, 9, 2, 10, 1}

	Sub Main()
		' Normally if we want to find the numbers less 7 we would use a for loop.
		Console.Write("For Loop Results - ")
		For i = 0 To numbers.Length() - 1
			If numbers(i) < 7 Then
				Console.Write("{0} ", numbers(i))
			End If
		Next
		Console.WriteLine()
		' Or we could use a for...each loop
		Console.Write("For...Each Loop Results - ")
		For Each number In numbers
			If number < 7 Then
				Console.Write("{0} ", number)
			End If
		Next
		Console.WriteLine()
		' Then came linq; here is expression (or query syntax).
		Console.Write("LINQ Expression Syntax Results - {0}", String.Join(" ", (From number In numbers Where number < 7 Select number)))
		Console.WriteLine()
		' Here is extension method syntax
		Console.Write("LINQ Extension Method Syntax Results - {0}", String.Join(" ", numbers.Where(Function(number) number < 7)))
		Console.WriteLine()
		' Finally this is what the compiler converts each of the others to
		Console.Write("LINQ Explicit Method Syntax Results - {0}", String.Join(" ", Enumerable.Where(numbers, Function(number) number < 7)))
		Console.ReadLine()
	End Sub
End Module

Open in new window

Produces the following output -Capture.JPG
I am currently working to recreate this wrapper for Access.  No promises on success.

-saige-
0
 

Author Comment

by:PeterFrb
ID: 41759860
Wow!  Another excellent post.  I copied the code block above, and I get the same results.  Yay.  (Sidebar: I changed "Console.Write..." do "Debug.Write" so I could view in the immediate window.  To what place does the console command write?)

I reference the Microsoft Office 15.0 Object Libraries (Excel 2013), and I don't have the Office 14 libraries available.  I'm assuming this is not a problem.

I copied and pasted the code form1.vb and ran into a snag.  I get the error "PInvokeStackImbalance was detected." in the InnerFromHandle function.  In your original, you defined "window" as "Excel.Window".  I actually revisited the code and made mine "Microsoft.Office.Interop.Excel.Window", to create parity with your code.   I did some digging, and this error occurs during the initialization of the class ClassExcelApps.  During the execution of FillList, the procedure goes through its paces until it encounters the error and stops.

I've included a screenshot.  Any suggestions?

Error in routine "InnerFromHandle".
0
 
LVL 32

Accepted Solution

by:
it_saige earned 500 total points
ID: 41760056
The libraries that you have referenced should work fine then.  I just rebuilt the project in VS2010 and besides having to change the Enumerables returned for the String.Join methods to arrays, the only other change was the Marshaled value from the AccessibleObjectFromWindow (your error came up for me as well).  I changed the signature on the ByRef value to MarshalAs an Interface.

So lets verify everything.

First, I rebuilt it in VS2010 targeting .NET 3.5 and set the target cpu to Any CPU.Capture.JPGSecond, I added references to Microsoft Office Object Library and Microsoft Excel Object Library.Capture.JPGFinally my complete code base:

Form1.vb -
Imports Microsoft.Office.Core
Imports Microsoft.Office.Interop
Imports System.Runtime.InteropServices
Imports System.Text

Public Class Form1
	Private Sub OnClick(sender As Object, e As EventArgs) Handles Button1.Click
		Dim excelApplications As New ExcelApplications()
		Label1.Text = String.Format("Total Excel Instances Running: {0}", excelApplications.Count)
		Label2.Text = String.Format("Total Excel Workbooks: {0}", (From [application] In excelApplications Select [application].Workbooks.Count).Sum())
		Label3.Text = String.Format("Total Excel Worksheets: {0}", (From [application] In excelApplications Select [application].Worksheets.Count).Sum())
		Label4.Text = String.Format("Workbook Names:{0}{1}", Environment.NewLine, String.Join(Environment.NewLine, (From [application] As Excel.Application In excelApplications
						    From [workbook] As Excel.Workbook In [application].Workbooks
						    Select [workbook].FullName).ToArray()))
		Label5.Text = String.Format("Worksheet Names:{0}{1}", Environment.NewLine, String.Join(Environment.NewLine, (From [application] As Excel.Application In excelApplications
							From [worksheet] As Excel.Worksheet In [application].Worksheets
							Select [worksheet].Name).ToArray()))
	End Sub

End Class

'' Based on code by JamesFaix - http://www.codeproject.com/Tips/1080611/Get-a-Collection-of-All-Running-Excel-Instances 
Class ExcelApplications
	Inherits List(Of Excel.Application)
	Private ReadOnly rrid As New Guid("{00020400-0000-0000-C000-000000000046}")

	Private Const MarshalName As String = "Excel.Application"
	Private Const ProcessName As String = "EXCEL"
	Private Const ComClassName As String = "EXCEL7"
	Private Const DW_OBJECTID = &HFFFFFFF0UI
	Private Const GW_HWNDPREV As UInt32 = 3

	Public Sub New()
		MyBase.New()
		FillList()
	End Sub

	Public Sub New(capacity As Integer)
		MyBase.New(capacity)
		FillList()
	End Sub

	Public Sub New(collection As IEnumerable(Of Excel.Application))
		MyBase.New(collection)
		FillList()
	End Sub

	Public Sub FillList()
		AddRange(From [process] In GetProcesses()
			Let application = FromProcess([process])
			Where application IsNot Nothing AndAlso Not Contains(application)
			Select application)
	End Sub

	Private Function FromProcess([process] As Process) As Excel.Application
		Try
			If [process] IsNot Nothing Then
				Return InnerFromProcess([process])
			End If
		Catch ex As Exception
			Return Nothing
		End Try
	End Function

	Public ReadOnly Property PrimaryInstance() As Excel.Application
		Get
			Try
				Return CType(Marshal.GetActiveObject(MarshalName), Excel.Application)
			Catch ex As Exception
				Return Nothing
			End Try
		End Get
	End Property

	Public ReadOnly Property TopMostInstance() As Excel.Application
		Get
			Try
				Return (From [application] In Me
				    Let ZAxis = GetWindowZ([application].Hwnd)
				    Where ZAxis > 0
				    Order By ZAxis
				    Select [application]).FirstOrDefault()
			Catch ex As Exception
				Return Nothing
			End Try
		End Get
	End Property

	Public Function GetProcesses() As IEnumerable(Of Process)
		Return Process.GetProcessesByName(ProcessName)
	End Function

	Private Function InnerFromProcess([process] As Process) As Excel.Application
		Return InnerFromHandle(ChildHandleFromMainHandle([process].MainWindowHandle))
	End Function

	Private Function ChildHandleFromMainHandle(handle As IntPtr) As IntPtr
		Dim childHandle As IntPtr = 0
		EnumChildWindows(handle, AddressOf EnumChildFunction, childHandle)
		Return childHandle
	End Function

	Private Function InnerFromHandle(handle As IntPtr) As Excel.Application
		Dim window As Excel.Window = Nothing
		Dim result = AccessibleObjectFromWindow(handle, DW_OBJECTID, rrid, window)
		Return window.Application
	End Function

	Private Function GetWindowZ(handle As IntPtr) As Integer
		Dim z = 0
		Dim h As IntPtr = handle
		While h <> IntPtr.Zero
			z += 1
			h = GetWindow(h, GW_HWNDPREV)
		End While
		Return z
	End Function

	Private Shared Function EnumChildFunction(hwndChild As Int32, ByRef lParam As Int32) As Boolean
		Dim buffer = New StringBuilder(128)
		GetClassName(hwndChild, buffer, 128)
		If buffer.ToString() = ComClassName Then
			lParam = hwndChild
			Return False
		End If
		Return True
	End Function

	<DllImport("oleacc.dll")> _
	Private Shared Function AccessibleObjectFromWindow(hwnd As IntPtr, id As UInteger, iid As Guid, <MarshalAs(UnmanagedType.Interface)> ByRef ppvObject As Object) As Integer
	End Function
	<DllImport("User32.dll")> _
	Private Shared Function EnumChildWindows(hWndParent As Int32, lpEnumFunc As EnumChildCallback, ByRef lParam As Int32) As [Boolean]
	End Function
	<DllImport("user32.dll", CharSet:=CharSet.Auto)> _
	Private Shared Function GetClassName(hWnd As IntPtr, lpClassName As StringBuilder, nMaxCount As Integer) As Integer
	End Function
	<DllImport("User32.dll")> _
	Private Shared Function GetWindow(hWnd As IntPtr, uCmd As UInt32) As IntPtr
	End Function

	Private Delegate Function EnumChildCallback(hwnd As Int32, ByRef lParam As Int32) As [Boolean]
End Class

Open in new window

Form1.Designer.vb -
<Global.Microsoft.VisualBasic.CompilerServices.DesignerGenerated()> _
Partial Class Form1
	Inherits System.Windows.Forms.Form

	'Form overrides dispose to clean up the component list.
	<System.Diagnostics.DebuggerNonUserCode()> _
	Protected Overrides Sub Dispose(ByVal disposing As Boolean)
		Try
			If disposing AndAlso components IsNot Nothing Then
				components.Dispose()
			End If
		Finally
			MyBase.Dispose(disposing)
		End Try
	End Sub

	'Required by the Windows Form Designer
	Private components As System.ComponentModel.IContainer

	'NOTE: The following procedure is required by the Windows Form Designer
	'It can be modified using the Windows Form Designer.  
	'Do not modify it using the code editor.
	<System.Diagnostics.DebuggerStepThrough()> _
	Private Sub InitializeComponent()
		Me.Button1 = New System.Windows.Forms.Button()
		Me.Label1 = New System.Windows.Forms.Label()
		Me.Label2 = New System.Windows.Forms.Label()
		Me.Label3 = New System.Windows.Forms.Label()
		Me.Label4 = New System.Windows.Forms.Label()
		Me.Label5 = New System.Windows.Forms.Label()
		Me.Label8 = New System.Windows.Forms.Label()
		Me.Label7 = New System.Windows.Forms.Label()
		Me.Label6 = New System.Windows.Forms.Label()
		Me.SuspendLayout()
		'
		'Button1
		'
		Me.Button1.Location = New System.Drawing.Point(12, 12)
		Me.Button1.Name = "Button1"
		Me.Button1.Size = New System.Drawing.Size(541, 29)
		Me.Button1.TabIndex = 1
		Me.Button1.Text = "Get Excel And Access Windows"
		Me.Button1.UseVisualStyleBackColor = True
		'
		'Label1
		'
		Me.Label1.AutoSize = True
		Me.Label1.Location = New System.Drawing.Point(13, 48)
		Me.Label1.Name = "Label1"
		Me.Label1.Size = New System.Drawing.Size(158, 13)
		Me.Label1.TabIndex = 2
		Me.Label1.Text = "Total Excel Instances Running: "
		'
		'Label2
		'
		Me.Label2.AutoSize = True
		Me.Label2.Location = New System.Drawing.Point(13, 74)
		Me.Label2.Name = "Label2"
		Me.Label2.Size = New System.Drawing.Size(121, 13)
		Me.Label2.TabIndex = 4
		Me.Label2.Text = "Total Workbooks Open:"
		'
		'Label3
		'
		Me.Label3.AutoSize = True
		Me.Label3.Location = New System.Drawing.Point(13, 100)
		Me.Label3.Name = "Label3"
		Me.Label3.Size = New System.Drawing.Size(123, 13)
		Me.Label3.TabIndex = 6
		Me.Label3.Text = "Total Worksheets Open:"
		'
		'Label4
		'
		Me.Label4.AutoSize = True
		Me.Label4.Location = New System.Drawing.Point(13, 126)
		Me.Label4.Name = "Label4"
		Me.Label4.Size = New System.Drawing.Size(96, 13)
		Me.Label4.TabIndex = 8
		Me.Label4.Text = "Workbook Names:"
		'
		'Label5
		'
		Me.Label5.AutoSize = True
		Me.Label5.Location = New System.Drawing.Point(13, 214)
		Me.Label5.Name = "Label5"
		Me.Label5.Size = New System.Drawing.Size(98, 13)
		Me.Label5.TabIndex = 9
		Me.Label5.Text = "Worksheet Names:"
		'
		'Label8
		'
		Me.Label8.AutoSize = True
		Me.Label8.Location = New System.Drawing.Point(298, 100)
		Me.Label8.Name = "Label8"
		Me.Label8.Size = New System.Drawing.Size(69, 13)
		Me.Label8.TabIndex = 15
		Me.Label8.Text = "Form Names:"
		'
		'Label7
		'
		Me.Label7.AutoSize = True
		Me.Label7.Location = New System.Drawing.Point(298, 74)
		Me.Label7.Name = "Label7"
		Me.Label7.Size = New System.Drawing.Size(94, 13)
		Me.Label7.TabIndex = 12
		Me.Label7.Text = "Total Forms Open:"
		'
		'Label6
		'
		Me.Label6.AutoSize = True
		Me.Label6.Location = New System.Drawing.Point(298, 48)
		Me.Label6.Name = "Label6"
		Me.Label6.Size = New System.Drawing.Size(167, 13)
		Me.Label6.TabIndex = 11
		Me.Label6.Text = "Total Access Instances Running: "
		'
		'Form1
		'
		Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
		Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
		Me.ClientSize = New System.Drawing.Size(565, 356)
		Me.Controls.Add(Me.Label8)
		Me.Controls.Add(Me.Label7)
		Me.Controls.Add(Me.Label6)
		Me.Controls.Add(Me.Label5)
		Me.Controls.Add(Me.Label4)
		Me.Controls.Add(Me.Label3)
		Me.Controls.Add(Me.Label2)
		Me.Controls.Add(Me.Label1)
		Me.Controls.Add(Me.Button1)
		Me.Name = "Form1"
		Me.Text = "Form1"
		Me.ResumeLayout(False)
		Me.PerformLayout()

	End Sub
	Friend WithEvents Button1 As System.Windows.Forms.Button
	Friend WithEvents Label1 As System.Windows.Forms.Label
	Friend WithEvents Label2 As System.Windows.Forms.Label
	Friend WithEvents Label3 As System.Windows.Forms.Label
	Friend WithEvents Label4 As System.Windows.Forms.Label
	Friend WithEvents Label5 As System.Windows.Forms.Label
	Friend WithEvents Label8 As System.Windows.Forms.Label
	Friend WithEvents Label7 As System.Windows.Forms.Label
	Friend WithEvents Label6 As System.Windows.Forms.Label

End Class

Open in new window

Produces the following output -Capture.JPGYou can disregard the access bits for now.

As for the output associated with Console.WriteLine().  In this case, the output goes to the output window (Debug --> Windows --> Output):Capture.JPGIn the case of a console application, the output goes to your console window; e.g. -Capture.JPG-saige-
0
 

Author Closing Comment

by:PeterFrb
ID: 41760260
First rate, top drawer, superlative work.  This second time around, everything worked just perfectly!  Thank you so much for the expert technique and instruction.  This post settles an outstanding question I've had on this topic for YEARS.  I even solicited the advice of Microsoft Tech Support on this very question, and they did come up with a solution that is not as elegant as this one.

Would it be easy to list whatever modifications are necessary to produce all the open Access applications?  If so, perhaps you could add that nugget.  If the code would be dramatically different, I can ask it as a separate question.  You're call.
0

Featured Post

Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now