Set reference to an open application

I want to determine if a Microsoft application (Excel, Access, Word, etc.) is curently running and set a reference to it. I then need to check all parent windows to see if a child window is a specific file name.

I have tried GetObject and AppActivate, but GetObject just creates a new instance of the application even if one is open. AppActivate does not seem to see the application, perhaps because its window is minimized.

I can use API functions like GetWindow and determine is the applicationis running, and I can use other functions to enumerate windows, child windows, return handles to windows, etc. However, I cannot get VB to set a reference to it.

The Shell function seems to mess up Excel, as I get the Application Title bar but the user window is as previous and I cannot use the Excel menu.

Does anyone have any ideas?
Who is Participating?

Improve company productivity with a Business Account.Sign Up

Richie_SimonettiConnect With a Mentor IT OperationsCommented:
something like this?

Private Sub Form_Click()
Dim xl As Excel.Application

Set xl = GetObject(, "excel.application")

Dim wb As Excel.Workbook, sname As String

For Each wb In xl.Workbooks
    sname = sname & wb.FullName & vbCrLf
MsgBox sname
Set xl = Nothing
End Sub
I don't know what you want to do with the application-reference, but this listing gives you an overview of the running processes (filenames) together with the Process ID (PID). This can be used to end a process (see EndProcess):

Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetCurrentProcess Lib "kernel32" () As Long
Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, lppe As PROCESSENTRY32) As Long
Declare Function CloseHandle Lib "Kernel32.dll" (ByVal Handle As Long) As Long
Declare Function EnumProcesses Lib "psapi.dll" (ByRef lpidProcess As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Declare Function GetModuleFileNameExA Lib "psapi.dll" (ByVal hProcess As Long, ByVal hModule As Long, ByVal ModuleName As String, ByVal nSize As Long) As Long
Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef cbNeeded As Long) As Long
Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFO) As Integer

   dwSize As Long
   cntUsage As Long
   th32ProcessID As Long           ' This process
   th32DefaultHeapID As Long
   th32ModuleID As Long            ' Associated exe
   cntThreads As Long
   th32ParentProcessID As Long     ' This process's parent process
   pcPriClassBase As Long          ' Base priority of process threads
   dwFlags As Long
   szExeFile As String * 260       ' MAX_PATH
End Type

   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long           '1 = Windows 95.
                                  '2 = Windows NT

   szCSDVersion As String * 128
End Type

Public Const PROCESS_VM_READ = 16
Public Const MAX_PATH = 260
Public Const SYNCHRONIZE = &H100000
Public Const TH32CS_SNAPPROCESS = &H2&
Public Const hNull = 0

Function StrZToStr(s As String) As String
   StrZToStr = Left$(s, Len(s) - 1)
End Function

Public Function getVersion() As Long
   Dim osinfo As OSVERSIONINFO
   Dim retvalue As Integer
   osinfo.dwOSVersionInfoSize = 148
   osinfo.szCSDVersion = Space$(128)
   retvalue = GetVersionExA(osinfo)
   getVersion = osinfo.dwPlatformId
End Function

Sub ListPID()
Select Case getVersion()

Case 1 'Windows 95/98

   Dim f As Long, sname As String
   Dim hSnap As Long, proc As PROCESSENTRY32
   hSnap = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
   If hSnap = hNull Then Exit Sub
   proc.dwSize = Len(proc)
   ' Iterate through the processes
   f = Process32First(hSnap, proc)
   Do While f
     sname = StrZToStr(proc.szExeFile)
     Debug.Print sname
     f = Process32Next(hSnap, proc)

Case 2 'Windows NT

   Dim cb As Long
   Dim cbNeeded As Long
   Dim NumElements As Long
   Dim ProcessIDs() As Long
   Dim cbNeeded2 As Long
   Dim NumElements2 As Long
   Dim Modules(1 To 200) As Long
   Dim lRet As Long
   Dim ModuleName As String
   Dim nSize As Long
   Dim hProcess As Long
   Dim i As Long
   'Get the array containing the process id's for each process object
   cb = 8
   cbNeeded = 96
   Do While cb <= cbNeeded
      cb = cb * 2
      ReDim ProcessIDs(cb / 4) As Long
      lRet = EnumProcesses(ProcessIDs(1), cb, cbNeeded)
   NumElements = cbNeeded / 4

   For i = 1 To NumElements
      'Get a handle to the Process
      hProcess = OpenProcess(PROCESS_QUERY_INFORMATION _
         Or PROCESS_VM_READ, 0, ProcessIDs(i))
      'Got a Process handle
      If hProcess <> 0 Then
          'Get an array of the module handles for the specified
          lRet = EnumProcessModules(hProcess, Modules(1), 200, _
          'If the Module Array is retrieved, Get the ModuleFileName
          If lRet <> 0 Then
             ModuleName = Space(MAX_PATH)
             nSize = 500
             lRet = GetModuleFileNameExA(hProcess, Modules(1), _
                             ModuleName, nSize)
             Debug.Print Left(ModuleName, lRet) & ": " & ProcessIDs(i)
          End If
      End If
    'Close the handle to the process
   lRet = CloseHandle(hProcess)

End Select
End Sub

Sub EndImmediate(PID)
Call TerminateProcess(OpenProcess(PROCESS_ALL_ACCESS, True, iif(PID=null,GetCurrentProcessId,PID)), 0)
End Sub
TimCotteeHead of Software ServicesCommented:
GetObject should work for you:

Public Function IsAppActive(ByVal Class As String,ByRef objApplication As Object) As Boolean
  On Error Resume Next
  Set objApplication = GetObject(,Class)
  IsAppActive = Not (objApplication Is Nothing)
End Function

Call it using something like this:

Dim appWord As Word.Application
Dim blnWordActive As Boolean
blnWordActive = IsAppActive("Word.Application",appWord)
MsgBox "Word Session " & iif(blnWordActive,"Is Active","Is Not Active",vbInformation
If blnWordActive Then
  'Do something with the object
End If

Dim appExcel As Excel.Application
Dim blnExcelActive As Boolean
blnExcelActive = IsAppActive("Excel.Application",appExcel)
MsgBox "Excel Session " & iif(blnExcelActive,"Is Active","Is Not Active",vbInformation
If blnExcelActive Then
  'Do something with the object
End If
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

TimCotteeHead of Software ServicesCommented:
You could extend the functionality to create the session if it doesn't exist:

Public Function IsAppActive(ByVal Class As String,ByRef objApplication As Object,Optional ByVal CreateSession As Boolean = True) As Boolean
 On Error Resume Next
 Set objApplication = GetObject(,Class)
 If CreateSession And objApplication Is Nothing Then
   Set objApplication = CreateObject(Class)
 End If
 IsAppActive = Not (objApplication Is Nothing)
End Function

This will default to creating the object if it does not already exist, you could change the default to false if you wanted.
Here's a little snippet of code that I use to detect if a previous instance of Excel is running.

If it's running, then I "take it over".

If it's not running, then I create a new one.

As a general rule, if your program creates an instance of Excel, then it should also close it.

This function returns: True - If Excel is running,

           :False if Excel is not running.

Hope this helps,

Drop me a line if you need more help.


Private Function ISExcelRunning() As Boolean

    'Determine if Excel is presently running or not
    Dim xlExcel As Excel.Application
    On Error Resume Next
    Set AppExcel = GetObject(, "Excel.Application")
    ISExcelRunning = (Err.Number = 0)
    Set AppExcel = Nothing
End Function
Richie_SimonettiIT OperationsCommented:
Strange, all people is posting the same approach with GetObject but i am sure that i was the first in comment it, so, how is possible that Tim's comment goes before mine!!!
i'm going crazy!
TimCotteeHead of Software ServicesCommented:
inethog, you are obviously new to this site so may not be aware of the guidelines. Please read the guidelines on comments vs answers at the bottom of this page. You are also posting to an "Abandoned" question. This appears to be an attempt to gain points by proposing an answer which has already been suggested in comments. I am referring this question to community support and will recommend that Richie's answer is accepted as he was the first (though my comment does seem to be first on the page!) Don't understand that either. If you continue to post answers in this way your account is liable to suspension.
TimCotteeHead of Software ServicesCommented:
inethog-->  Welcome to Experts Exchange. As TimCottee noted above,  it is against guidelines to lock questions with proposed answers unless your response is the first and only correct answer to the question at hand.  Furthermore, it creates a disservice to the Asker to have their questions locked rather than to receive comments and insights, since it moved the item from the Open Question queue to the Locked queue, where few will step in to help further.  Asker can always choose to award the first best comment as the accepted answer.  Please read the information contained in the HELP DESK link on the left, which provides you with Member Agreement, site Guidelines and the Question/Answer process.

I have force accepted the response from Richie_Simonetti and moved this item with points to the PAQ (Previously Asked Question) database.

TimCottee, if the right thing to do here is to also award your contributions with a separate points-for Q, please let me know.

Thanks all,
Moondancer - EE Moderator
Richie_SimonettiIT OperationsCommented:
I agree with you Moondancer.
I could post a points for... in this TA for TimCottee since, really, i don't understand what did happens here with dates. Maybe in the migration proccess... who knows?
many thanks to both of you.
No, Richie, your points shouldn't be used for this purpose.  Since this was a 300 pt Q, max allowed, what I can do is to take this down to half, and post the other half for Tim.  Would that sound right to all?

Moondancer - EE Moderator
Assuming this will be OK by you both, have done this, since I have a meeting to attend and will be offline for a few hours.

Points for TimCottee - > qid=20279314

Point splits processed, this item adjusted to 150 points, the other 150 in link above.

Thank you,
Moondancer - EE Moderator
Richie_SimonettiIT OperationsCommented:
Good to me.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.