Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
  ByVal lpClassName As String, _
  ByVal lpWindowName As String) As Long

Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long

Const WM_CLOSE = &H10

Sub CloseApp()
    Dim lngHwnd As Long
    Dim lngReturn As Long
    
    lngHwnd = FindWindow(vbNullString, "A.txt - Блокнот")
    
    'Debug.Print lngHwnd
    
    If lngHwnd <>  0  Then
        lngReturn = PostMessage(lngHwnd, WM_CLOSE,  0 &,  0 &)
        If lngReturn =  0  Then
            MsgBox "Произошла ошибка."
        End If
    Else
        MsgBox "Приложение не открыто."
    End If
End Sub

Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
  ByVal strClassName As String, _
  ByVal lpWindowName As Any) As Long

Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
  ByVal hwnd As Long, _
  ByVal wMsg As Long, _
  ByVal wParam As Long, _
  lParam As Any) As Long

Const WM_CLOSE = &H10

Function fctIsAppLoaded(ByVal varClassName As Variant) As Long
   If IsNull(varClassName) Then
      fctIsAppLoaded =  0 
   Else
      fctIsAppLoaded = FindWindow(CStr(varClassName),  0 &)
   End If
End Function

Sub CloseApp()
    If fctIsAppLoaded("notepad") <>  0  Then
        PostMessage fctIsAppLoaded("notepad"), WM_CLOSE,  0 &,  0 &
    Else
        MsgBox "Приложение не открыто."
    End If
End Sub

Private Declare Function FindWindow Lib "user32" _
            Alias "FindWindowA" _
            (ByVal lpClassName As Long, _
            ByVal lpWindowName As Long) As Long

Private Declare Function GetParent Lib "user32" _
            (ByVal hwnd As Long) As Long

Private Declare Function SetParent Lib "user32" _
            (ByVal hWndChild As Long, _
            ByVal hWndNewParent As Long) As Long

Private Declare Function GetWindowThreadProcessId Lib "user32" _
            (ByVal hwnd As Long, _
            lpdwProcessId As Long) As Long

Private Declare Function GetWindow Lib "user32" _
            (ByVal hwnd As Long, _
            ByVal wCmd As Long) As Long

Private Declare Function LockWindowUpdate Lib "user32" _
            (ByVal hwndLock As Long) As Long

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function DestroyWindow Lib "user32" _
            (ByVal hwnd As Long) As Long

Private Declare Function TerminateProcess Lib "kernel32" _
            (ByVal hProcess As Long, _
            ByVal uExitCode As Long) As Long

Private Declare Function GetCurrentProcess Lib "kernel32" () As Long

Private Declare Function Putfocus Lib "user32" _
            Alias "SetFocus" _
            (ByVal hwnd As Long) As Long

Const GW_HWNDNEXT =  2 
Dim mWnd As Long
Function InstanceToWnd(ByVal target_pid As Long) As Long
    Dim test_hwnd As Long, test_pid As Long, test_thread_id As Long
    'Find the first window
    test_hwnd = FindWindow(ByVal  0 &, ByVal  0 &)
    Do While test_hwnd <>  0 
        'Check if the window isn't a child
        If GetParent(test_hwnd) =  0  Then
            'Get the window's thread
            test_thread_id = GetWindowThreadProcessId(test_hwnd, _
            test_pid)
            If test_pid = target_pid Then
                InstanceToWnd = test_hwnd
                Exit Do
            End If
        End If
        'retrieve the next window
        test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
    Loop
End Function

Private Sub Form_Load()
    Dim Pid As Long
    'Lock the window update
    LockWindowUpdate GetDesktopWindow
    'Execute notepad.Exe
    Pid = Shell("c:\winnt\notepad.exe", vbNormalFocus)
    If Pid =  0  Then MsgBox "Error starting the app"
    'retrieve the handle of the window
    mWnd = InstanceToWnd(Pid)
    'Set the notepad's parent
    SetParent mWnd, Me.hwnd
    'Put the focus on notepad
    Putfocus mWnd
    'Unlock windowupdate
    LockWindowUpdate False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    'Unload notepad
    'DestroyWindow mWnd
    'End this program
    'TerminateProcess GetCurrentProcess, 0
End Sub

Dim WinWnd As Long
    Dim Ret As String
    Dim RetVal As Long
    Dim lpClassName As String
    'Ret = "Безымянный - Блокнот"  'InputBox("Введите точный заголовок окна:" & vbCrLf & _
            "Важно: должно быть точное соответствие")
    'Ищим окно
    Ret = "Fetchy - Search All Major Search Engines At Once And Win Tons Of Cash And Prizes! - Microsoft Internet Explorer"
    WinWnd = FindWindow(vbNullString, Ret)
    If WinWnd =  0  Then
        MsgBox "Окно не найдено ..."
        Exit Sub
    End If
    'Показываем найденное окно
    ShowWindow WinWnd, SW_SHOWNORMAL
    'Создаём буфер
    lpClassName = Space( 256 )
    'Получаем имя класса
    RetVal = GetClassName(WinWnd, lpClassName,  256 )
    'Показываем имя класса
    MsgBox "Имя класса : " & Left$(lpClassName, RetVal)
    'Посылаем сообщение закрытия окна
    PostMessage WinWnd, WM_CLOSE,  0 &,  0 &

Private Declare Function FindWindow Lib "user32" _
            Alias "FindWindowA" _
            (ByVal lpClassName As String, _
            ByVal lpWindowName As String) As Long

Private Declare Function PostMessage Lib "user32" _
            Alias "PostMessageA" _
            (ByVal hwnd As Long, _
            ByVal wMsg As Long, _
            ByVal wParam As Long, _
            lParam As Any) 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 ShowWindow Lib "user32" _
            (ByVal hwnd As Long, _
            ByVal nCmdShow As Long) As Long

Const SW_SHOWNORMAL =  1 
Const WM_CLOSE = &H10
Const gcClassnameMSWord = "OpusApp"
Const gcClassnameMSExcel = "XLMAIN"
Const gcClassnameMSIExplorer = "IEFrame"
Const gcClassnameMSVBasic = "wndclass_desked_gsk"
Const gcClassnameNotePad = "Notepad"
Const gcClassnameMyVBApp = "ThunderForm"