Option Explicit

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

Private Declare Function SystemParametersInfo Lib "user32" _
                  Alias "SystemParametersInfoA" _
   (ByVal uiAction As Long, _
    ByVal uiParam As Long, _
    ByRef pvParam As Long, _
    ByVal fWinIni As Long) As Long

Private Const SPI_GETFOREGROUNDLOCKTIMEOUT As Long = &H2000&
Private Const SPI_SETFOREGROUNDLOCKTIMEOUT As Long = &H2001&

Private Declare Function AttachThreadInput Lib "user32" _
    (ByVal idAttach As Long, _
     ByVal idAttachTo As Long, _
     ByVal fAttach As Long) As Long

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

Private Declare Function SetForegroundWindow Lib "user32" _
   (ByVal hWnd As Long) As Long

Public Sub SetForceForegroundWindow(ByVal hWnd As Long)
    Dim ThreadID1 As Long
    Dim ThreadID2 As Long
    Dim LockTimeout As Long

    ThreadID1 = GetWindowThreadProcessId(GetForegroundWindow(), ByVal 0&)
    ThreadID2 = App.ThreadID
    If ThreadID1 <> ThreadID2 Then
        AttachThreadInput ThreadID2, ThreadID1, 1
    End If
    SystemParametersInfo SPI_GETFOREGROUNDLOCKTIMEOUT, 0, LockTimeout, 0
    SystemParametersInfo SPI_SETFOREGROUNDLOCKTIMEOUT, 0, ByVal 0&, 0
    SetForegroundWindow hWnd
    SystemParametersInfo SPI_SETFOREGROUNDLOCKTIMEOUT, 0, ByVal LockTimeout, 0
    If ThreadID1 <> ThreadID2 Then
        AttachThreadInput ThreadID2, ThreadID1, 0
    End If
End Sub