làm thế nào để đóng một ứng dụng để không bị lỗi ?

[phamvandunghp84]

Mình đang dùng câu lệnh sau để đóng chrome nhưng gặp vấn đề là lần sau khi mở lại nó báo lỗi ..do không được đóng đúng cách..
Mình muốn hỏi ngoài cách đóng này ra có cách nào đóng để lần tới mở chrome thì không bị thông báo " Chorme didn't shut down correctly.
hay có cách đóng nào giống như mình bấm chuột vào nút X không ? Cảm ơn các bạn !
Shell "Taskkill /F /IM chrome.exe"

 

[HeSanbi]

Bạn có thể sử dụng Code dưới đây.


Gọi thủ tục QuitChromeApp để đóng Chrome đúng cách.
----------------------------------------

Option Explicit
#If VBA7 Then
  #If Win64 Then
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal wIndx As LongPtr) As Long
    Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
  #Else
    Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal wIndx As LongPtr) As Long
  #End If
  Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
  Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hwnd As LongPtr) As Boolean
  Private Declare PtrSafe Function GetAncestor Lib "user32" (ByVal hwnd As LongPtr, ByVal flags As Long) As Long
  Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
  Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As LongPtr, lpdwProcessId As Long) As Long
  Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As LongPtr, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
#Else
  Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal wIndx As Long) As Long
  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Boolean
  Private Declare Function GetAncestor Lib "user32" (ByVal hwnd As Long, ByVal flags As Long) As Long
  Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
  Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
  Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If


Sub QuitChromeApp()
   On Error Resume Next
  #If VBA7 Then
  Dim lHwnd       As LongPtr
  #Else
  Dim lHwnd       As Long
  #End If
  Dim objProcess As Object
  For Each objProcess In VBA.GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2"). _
                ExecQuery("select * from win32_process Where Name = 'chrome.exe'", , 48)
       lHwnd= GetHWnd(objProcess.ProcessID)
       If lHwnd <> &HFFFF And lHwnd <> 0 Then
          Call PostMessage(lHwnd, &H10, 0&, 0&)
          Exit For
       End if
  Next
  On Error GoTo 0
  Set objProcess = Nothing
End Sub

#If Win64 Then
Public Function GetHWnd(ByVal PID As Long) As LongPtr
#Else
Public Function GetHWnd(ByVal PID As Long) As Long
#End If
  Const GWL_EXSTYLE As Long = (-20)
  Const WS_EX_TOOLWINDOW As Long = &H80
  Const WS_EX_APPWINDOW As Long = &H40000
  Const GW_OWNER  As Long = 4

  #If VBA7 Then
  Dim lHwnd       As LongPtr
  #Else
  Dim lHwnd       As Long
  #End If

  Dim test_pid    As Long
  Dim Thread_ID   As Long
  Dim lExStyle    As Long
  Dim bNoOwner    As Boolean
  lHwnd = FindWindow(vbNullString, vbNullString)
  Do While lHwnd <> 0
    If IsWindowVisible(lHwnd) Then
      If GetParent(lHwnd) = 0 Then
        bNoOwner = (GetWindow(lHwnd, GW_OWNER) = 0)
        lExStyle = GetWindowLong(lHwnd, GWL_EXSTYLE)
        If (((lExStyle And WS_EX_TOOLWINDOW) = 0) And bNoOwner) Or _
          ((lExStyle And WS_EX_APPWINDOW) And Not bNoOwner) Then
          Thread_ID = GetWindowThreadProcessId(lHwnd, test_pid)
          If test_pid = PID Then
            Const GA_ROOT = 2
            lHwnd = GetAncestor(lHwnd, GA_ROOT)
            GetHWnd = lHwnd
            Exit Function
          End If
        End If
      End If
    End If
    lHwnd = GetWindow(lHwnd, 2) 'GW_HWNDNEXT = 2
  Loop
End Function

 

[batman1]

1. Nếu bạn có ngay từ đầu một vài ứng dụng mà bạn quan tâm thì có thể làm đơn giản. Vd. bạn muốn đóng chrome.exe, firefox.exe, notepad.exe thì có thể tìm theo lớp của cửa sổ.
Chay sub test.

Private Const WM_CLOSE As Long = &H10

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
#Else
    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If

Sub test()
#If VBA7 Then
    Dim hWnd As LongPtr
#Else
    Dim hWnd As Long
#End If
    hWnd = FindWindow("notepad", vbNullString)
'    hWnd = FindWindow("MozillaWindowClass", vbNullString)
'    hWnd = FindWindow("Chrome_WidgetWin_1", vbNullString)
    If hWnd Then PostMessage hWnd, WM_CLOSE, 0, 0
End Sub

Cách này không hay nếu tên lớp cửa sổ thay đổi theo phiên bản của ứng dụng.

2. Trường hợp tìm theo tên EXE.
Chạy sub test.

Private Const PROCESS_QUERY_INFORMATION As Long = (&H400)
Private Const PROCESS_VM_READ As Long = (&H10)
Private Const WM_CLOSE As Long = &H10

#If VBA7 Then
    Private Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As LongPtr, lphModule As LongPtr, ByVal cb As Long, lpcbNeeded As Long) As LongPtr
    Private Declare PtrSafe Function GetModuleBaseName Lib "psapi.dll" Alias "GetModuleBaseNameA" (ByVal hProcess As LongPtr, ByVal hModule As LongPtr, ByVal lpFilename As String, ByVal nSize As Long) As LongPtr
    Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long
    Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPtr
    Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal hObject As LongPtr) As Long
    Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
    Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
    Private Declare Function PostMessage Lib "user32.dll" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Declare Function EnumProcessModules Lib "psapi.dll" (ByVal hProcess As Long, ByRef lphModule As Long, ByVal cb As Long, ByRef lpcbNeeded As Long) As Long
    Private Declare Function GetModuleBaseName Lib "psapi.dll" Alias "GetModuleBaseNameA" (ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFilename As String, ByVal nSize As Long) As Long
    Private Declare Function GetWindowThreadProcessId Lib "user32.dll" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
    Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
    Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
    Private Declare Function IsWindowVisible Lib "user32.dll" (ByVal hWnd As Long) As Long
#End If

Private appName As String

#If VBA7 Then
Function EnumWindowsProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long
    Dim lModules() As LongPtr, hProcess As LongPtr
#Else
Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
    Dim lModules() As Long, hProcess As Long
#End If
Const MAX_PATH As Long = 260
Dim ProcId As Long, cbNeeded As Long, sName As String
    EnumWindowsProc = 1
    If IsWindowVisible(hWnd) Then
        GetWindowThreadProcessId hWnd, ProcId
        hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, ProcId)
        If hProcess Then
            ReDim lModules(1 To 1024)
            If EnumProcessModules(hProcess, lModules(1), 1024 * LenB(lModules(1)), cbNeeded) Then
                sName = String(MAX_PATH, vbNullChar)
                GetModuleBaseName hProcess, lModules(1), sName, MAX_PATH
                sName = LCase(Left(sName, InStr(sName, vbNullChar) - 1))
                If sName = appName Then PostMessage hWnd, WM_CLOSE, 0, 0
            End If
            CloseHandle hProcess
        End If
    End If
End Function

Private Sub CloseApp(ByVal ProcName As String)
    appName = ProcName
    EnumWindows AddressOf EnumWindowsProc, 0
End Sub

Sub test()
    CloseApp "firefox.exe"
'    CloseApp "chrome.exe"
'    CloseApp "winword.exe"
'    CloseApp "notepad.exe"
End Sub

Tôi chưa test với office 64 bit vì không có.

Lưu ý.
Tôi quên, sau khi tìm thấy và đóng ứng dụng thì nên kết thúc EnumWindows để tiết kiệm điện nước.
Tức thay

If sName = appName Then PostMessage hWnd, WM_CLOSE, 0, 0

bằng.

If sName = appName Then
                    PostMessage hWnd, WM_CLOSE, 0, 0
                    EnumWindowsProc = 0
End If

 

[batman1]

Không hiểu sao lại gửi lần 2.