ExcelBanter - How to detect MS Word or MS Access calls MS Excel using VBA

This is more difficult than I thought and I still don't understand it fully,
but here is some
code that might give you a start.
I am sure somebody more familiar with this can improve on it.

Option Explicit
Private Const GW_HWNDFIRST As Long = 0
Private Const GW_HWNDLAST As Long = 1
Private Const GW_HWNDNEXT As Long = 2
Private Const GW_HWNDPREV As Long = 3
Private Const GW_OWNER As Long = 4
Private Const GW_CHILD As Long = 5
Private Const GWL_HINSTANCE As Long = -6

Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function GetWindow Lib "user32" _
(ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) 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 GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As Long,
_
ByVal nIndex _
As Long) As Long

Function FindWindowHwndLike(hWndStart As Long, _
ClassName As String, _
WindowTitle As String, _
level As Long, _
lHolder As Long, _
Optional lHinstanceToFind As Long = -1, _
Optional coll As Collection) As Long

'finds the first window where the class name starts with ClassName
'and where the Window title starts with WindowTitle, returns Hwnd
'optionally finds:
'the hwnd of the calling process found by the Hinstance
'the window title of this calling application
'the window class of this calling application
'------------------------------------------------------------------
Dim hwnd As Long
Dim sWindowTitle As String
Dim sClassName As String
Dim r As Long
Static bFound As Boolean
Dim lCurrentHinstance As Long
Dim arr(1 To 3)

If level = 0 Then
bFound = False
End If

If bFound Then
Exit Function
End If

'Initialize if necessary. This is only executed
'when level = 0 and hWndStart = 0, normally
'only on the first call to the routine.
'----------------------------------------------
If level = 0 Then
If hWndStart = 0 Then
hWndStart = GetDesktopWindow()
End If
End If

'Increase recursion counter
'--------------------------
level = level + 1

'Get first child window
'----------------------
hwnd = GetWindow(hWndStart, GW_CHILD)

Do While hwnd 0 And bFound = False

'Search children by recursion
'----------------------------
lHolder = FindWindowHwndLike(hwnd, _
ClassName, _
WindowTitle, _
level, _
lHolder, _
lHinstanceToFind, _
coll)

'Get the window text
'-------------------
sWindowTitle = Space$(255)
r = GetWindowText(hwnd, sWindowTitle, 255)
sWindowTitle = Left$(sWindowTitle, r)

'get the class name
'------------------
sClassName = Space$(255)
r = GetClassName(hwnd, sClassName, 255)
sClassName = Left$(sClassName, r)

If lHinstanceToFind -1 Then
lCurrentHinstance = GetWindowLong(lHolder, _
GWL_HINSTANCE)
If lCurrentHinstance = lHinstanceToFind Then
arr(1) = lHolder
arr(2) = sWindowTitle
arr(3) = sClassName
coll.Add arr
FindWindowHwndLike = hwnd
lHolder = hwnd
bFound = True
Exit Function
End If
End If

If InStr(1, sWindowTitle, WindowTitle, vbTextCompare) 0 And _
InStr(1, sClassName, ClassName, vbTextCompare) 0 Then
FindWindowHwndLike = hwnd
lHolder = hwnd
If lHinstanceToFind = -1 Then
bFound = True
Exit Function
End If
End If

'Get next child window
'---------------------
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop

FindWindowHwndLike = lHolder

End Function

Sub test()

Dim lHinstance As Long
Dim coll As Collection
Dim strResult As String
Dim i As Long

Set coll = New Collection

lHinstance = Application.Hinstance

FindWindowHwndLike 0, _
"", _
"CallingApp.xls", _
0, _
0, _
lHinstance, _
coll

For i = 1 To coll.Count
strResult = strResult & _
coll(i)(1) & " -- " & _
coll(i)(2) & " -- " & _
coll(i)(3) & _
vbCrLf
Next

MsgBox "Finding callers for Hinstance: " & lHinstance & _
vbCrLf & vbCrLf & _
strResult, , _
"calling hwnd -- calling window title -- calling window class"

End Sub

RBS

"Bon" wrote in message
oups.com...
Hello all

Is it possible to detect which application call the MS Excel using VBA?

I want to put some conditions in the Workbook_Open() method.

IF MS Word call Then
Do Job 1
Else
Do Job 2

Any methods for doing it?

Thanks
Bon