'This set of functions determines if a window is open and if necessary closes that window. This is useful to avoid opening multiple instances of an application, especially if the application is a hidden background operation. To achieve this function, 5 windows API calls are employed to determine all open applications, check their identity and message these applications in order to issue a closedown call if required. The code below can be copied to a module and forms a complete working unit:
Option Explicit
Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, _
ByVal aint As Long) As Long
Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function EnumWindows Lib "user32" _
(ByVal wndenmprc As Long, ByVal lParam As Long) As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Const WM_CLOSE = &H10
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDLAST = 1
Private Const GW_HWNDNEXT = 2
Private Const GW_HWNDPREV = 3
Private Const GW_OWNER = 4
Private Const GW_CHILD = 5
Private Const GW_MAX = 5
Private mstrTarget As String
Private mblnSuccess As Boolean
Public Function blnFindWindow(strApplicationTitle As String) As Boolean
Dim hWndTmp As Long
Dim nRet As Integer
Dim TitleTmp As String
Dim TitlePart As String
Dim MyWholeTitle As String
Dim mCounter As Long
Dim hWndOver As Integer
Dim sClassName As String * 100
blnFindWindow = False
TitlePart = UCase$(strApplicationTitle)
'loop through all the open windows
hWndTmp = FindWindow(0&, 0&)
Do Until hWndTmp = 0
TitleTmp = Space$(256)
nRet = GetWindowText(hWndTmp, TitleTmp, Len(TitleTmp))
If nRet Then
'retrieve window title
TitleTmp = UCase$(VBA.Left$(TitleTmp, nRet))
'compare window title & strApplicationTitle
If InStr(TitleTmp, TitlePart) Then
blnFindWindow = True
Exit Do
End If
End If
hWndTmp = GetWindow(hWndTmp, GW_HWNDNEXT)
mCounter = mCounter + 1
Loop
End Function
Public Function blnCloseWindow(strApplicationTitle As String) As Boolean
' retrieve Windows list of tasks.
mblnSuccess = False
mstrTarget = strApplicationTitle
EnumWindows AddressOf EnumCallback, 0
blnCloseWindow = mblnSuccess
End Function
Public Function EnumCallback(ByVal app_hWnd As Long, _
ByVal param As Long) As Long
Dim buf As String * 256
Dim title As String
Dim length As Long
' Checks a returned task to determine if App should be closed
' get window's title.
length = GetWindowText(app_hWnd, buf, Len(buf))
title = Left$(buf, length)
' determine if target window.
If InStr(UCase(title), UCase(mstrTarget)) <> 0 Then
' Kill window.
SendMessage app_hWnd, WM_CLOSE, 0, 0
mblnSuccess = True
End If
' continue searching.
EnumCallback = 1
End Function
'The usage of these function is straight forward and fall into 2 parts: determining if a specific application is open and if necessary closing that application. The 2 function all are as follows:
If blnFindWindow("Notepad") Then
If Not blnCloseWindow("Notepad") Then
MsgBox "Problems encountered closing Window", _
vbInformation, "API Call"
Exit Sub
End If
End If
