1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82
| Option Explicit
Public Declare Function SetWindowPos _
Lib "user32" ( _
ByVal Hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long) _
As Long
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
''https://www.extendoffice.com/documents/excel/2030-keep-excel-window-on-top.html
Sub Test_Open_Outlook()
Dim Chemin As String
Chemin = "C:\Program Files (x86)\Microsoft Office\root\Office16\OUTLOOK.exe"
Dim Appli As Object
Dim session_Outlook As New Outlook.Application
Dim Ole_appli As Object
Dim typouv As Byte
typouv = 1
On Error Resume Next
Set Appli = GetObject(, "Outlook.Application")
Call ShowXLOnTop(True)
If Appli Is Nothing Then
'Ouvre Outlook
session_Outlook = Shell(Chemin, typouv)
Else
'Fermeture de l'application Outlook si ouverte et réouverture d'une nouvelle
Call KillProcess("Outlook.exe")
session_Outlook = Shell(Chemin, typouv)
End If
Set Ole_appli = Nothing
Set Appli = Nothing
Call ShowXLOnTop(False)
End Sub
Sub ShowXLOnTop(ByVal OnTop As Boolean)
Dim xStype As Long
Dim xHwnd As Long
If OnTop Then
xStype = HWND_TOPMOST
Else
xStype = HWND_NOTOPMOST
End If
Call SetWindowPos(Application.Hwnd, xStype, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Sub
'https://vb.developpez.com/faq/?page=Systeme#killprocess
Public Function KillProcess(ByVal ProcessName As String) As Boolean
Dim svc As Object
Dim sQuery As String
Dim oproc
Set svc = GetObject("winmgmts:root\cimv2")
sQuery = "select * from win32_process where name='" & ProcessName & "'"
For Each oproc In svc.execquery(sQuery)
oproc.Terminate
Next
Set svc = Nothing
End Function |
Partager