MyTetra Share
Делитесь знаниями!
Find/Close Windows Application
Время создания: 10.02.2021 20:21
Текстовые метки: VBA, окна, Window
Раздел: !Закладки - VBA
Запись: adgaver/mytetra_base_New/master/base/1612977674v8311jt2mv/text.html на raw.githubusercontent.com

'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

Так же в этом разделе:
 
MyTetra Share v.0.55
Яндекс индекс цитирования