VERIFICAR SE DETERMINADO PROGRAMA ESTA EM EXECUCAO
Olá! Alguém saberia uma função que informo o nome do programa, e ele verifica se está em execução. E informar está em execução não está em execução.
Dim uLngProcess As Long
uLngProcess = GetProcessIDByEXEName([Ô]calc.exe[Ô])
If uLngProcess <> 0 Then ProcessTerminate uLngProcess
nesse exemplo se a calculadora estiver aberta, sera fechada.
uLngProcess = GetProcessIDByEXEName([Ô]calc.exe[Ô])
If uLngProcess <> 0 Then ProcessTerminate uLngProcess
nesse exemplo se a calculadora estiver aberta, sera fechada.
NILSONTRES, só faltaram as declarações dessas API...
Option Explicit
Global Const MAX_PATH = 260
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const TOKEN_ADJUST_PRIVILEGES = &H20
Private Const TOKEN_QUERY = &H8
Declare Function CloseHandle Lib [Ô]kernel32[Ô] (ByVal hObject As Long) As Long
Declare Function OpenProcess Lib [Ô]kernel32[Ô] (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CreateToolhelp32Snapshot Lib [Ô]kernel32[Ô] (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function ProcessFirst Lib [Ô]kernel32[Ô] Alias [Ô]Process32First[Ô] (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib [Ô]kernel32[Ô] Alias [Ô]Process32Next[Ô] (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function GetWindowThreadProcessId Lib [Ô]user32[Ô] (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function LookupPrivilegeValue Lib [Ô]advapi32[Ô] Alias [Ô]LookupPrivilegeValueA[Ô] (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function OpenProcessToken Lib [Ô]advapi32[Ô] (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function AdjustTokenPrivileges Lib [Ô]advapi32[Ô] (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength 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 Type PROCESSENTRY32: dwSize As Long: cntUsage As Long: th32ProcessID As Long: th32DefaultHeapID As Long: th32ModuleID As Long: cntThreads As Long: th32ParentProcessID As Long: pcPriClassBase As Long: dwFlags As Long: szExeFile As String * MAX_PATH: End Type
Private Type LUID: UsedPart As Long: IgnoredForNowHigh32BitPart As Long: End Type
Private Type TOKEN_PRIVILEGES: PrivilegeCount As Long: TheLuid As LUID: Attributes As Long: End Type
Function GetProcessIDByEXEName(ByVal EXEName As String) As Long
Dim hSnapShot As Long
Dim uProcess As PROCESSENTRY32
Dim r As Long, lStrtemp As String
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0&)
If hSnapShot = -1 Then Exit Function
uProcess.dwSize = Len(uProcess)
r = ProcessFirst(hSnapShot, uProcess)
Do While r
If InStr(UCase(uProcess.szExeFile), UCase(EXEName)) <> 0 Then
GetProcessIDByEXEName = uProcess.th32ProcessID
Call CloseHandle(hSnapShot)
Exit Function
End If
r = ProcessNext(hSnapShot, uProcess)
Loop
Call CloseHandle(hSnapShot)
End Function
Function ProcessTerminate(Optional lProcessID As Long, Optional lHwndWindow As Long) As Boolean
Dim lhwndProcess As Long
Dim lExitCode As Long
Dim lRetVal As Long
Dim lhThisProc As Long
Dim lhTokenHandle As Long
Dim tLuid As LUID
Dim tTokenPriv As TOKEN_PRIVILEGES, tTokenPrivNew As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
Const PROCESS_ALL_ACCESS = &H1F0FFF, PROCESS_TERMINATE = &H1
Const ANYSIZE_ARRAY = 1, TOKEN_ADJUST_PRIVILEGES = &H20
Const TOKEN_QUERY = &H8, SE_DEBUG_NAME As String = [Ô]SeDebugPrivilege[Ô]
Const SE_PRIVILEGE_ENABLED = &H2
On Error Resume Next
If lHwndWindow Then
[ô]Get the process ID from the window handle
lRetVal = GetWindowThreadProcessId(lHwndWindow, lProcessID)
End If
If lProcessID Then
[ô]Give Kill permissions to this process
lhThisProc = GetCurrentProcess
OpenProcessToken lhThisProc, TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, lhTokenHandle
LookupPrivilegeValue [Ô][Ô], SE_DEBUG_NAME, tLuid
[ô]Set the number of privileges to be change
tTokenPriv.PrivilegeCount = 1
tTokenPriv.TheLuid = tLuid
tTokenPriv.Attributes = SE_PRIVILEGE_ENABLED
[ô]Enable the kill privilege in the access token of this process
AdjustTokenPrivileges lhTokenHandle, False, tTokenPriv, Len(tTokenPrivNew), tTokenPrivNew, lBufferNeeded
[ô]Open the process to kill
lhwndProcess = OpenProcess(PROCESS_TERMINATE, 0, lProcessID)
If lhwndProcess Then
[ô]Obtained process handle, kill the process
ProcessTerminate = CBool(TerminateProcess(lhwndProcess, lExitCode))
Call CloseHandle(lhwndProcess)
End If
End If
On Error GoTo 0
End Function
Function GetProcess(ProcessName As String)
Dim uLngProcess As Long
uLngProcess = GetProcessIDByEXEName([Ô]winword.exe[Ô])
If uLngProcess <> 0 Then
[ô] MsgBox [Ô]Processo [ô][Ô] + ProcessName + [Ô][ô] está em execução[Ô], vbExclamation, [Ô]Processo em execução[Ô]
GetProcess = 1
Else
[ô] MsgBox [Ô]O processo [ô][Ô] + ProcessName + [Ô][ô] não está em execução[Ô], vbCritical, [Ô]Processo não iniciado[Ô]
GetProcess = 0
End If
End Function
__________________________________________________________________
No botão que exporta:
__________________________________________________________________
If GetProcess([Ô]EXCEL.EXE[Ô]) = 1 Then
If MsgBox([Ô]Parece haver algum documento do Excel aberto, o que causará problemas durante a exportação. O sistema pode tentar fechá-lo para você.[Ô] & vbCrLf & vbCrLf & [Ô]Tentar fechar o Excel agora? Caso algum documento contenha alterações não salvas, você terá que salvá-las ou descartá-las manualmente.[Ô], vbYesNo + vbCritical, [Ô]Instância do Excel em aberto[Ô]) = vbNo Then
MsgBox [Ô]Você optou por não fechar instâncias abertas do Excel. A exportação será cancelada. Feche todas as intâncias do Excel e tente novamente. Caso não esteja vendo nenhuma janela do Excel na tela e nem na barra de tarefas, pode ser que ele esteja iniciado nos processos do Windows. Para verificar, mantenha pressionadas as teclas Ctrl e Alt e pressione a tecla Del ou Delete. Clique em Gerenciador de tarefas e na aba Processos. Procure por EXCEL.EXE. Caso o encontre, selecione-o e clique no botão Finalizar processo e confirme.[Ô], vbCritical, [Ô]Erro[Ô]
Exit Sub
Else
Finalizar ([Ô]EXCEL.EXE[Ô])
End If
End If
__________________________________________________________________
Pode ser usado para qualquer programa, bastando alterar no Finalizar ([Ô]NomeDoPrograma.exe[Ô])
Tópico encerrado , respostas não são mais permitidas