'--------------------------------------------------------------
' Copyright ©1996-2002 VBnet, Randy Birch, All Rights Reserved.
' Terms of use [URL unfurl="true"]http://www.mvps.org/vbnet/terms/pages/terms.htm[/URL]
'--------------------------------------------------------------
'Extremely minor mods by danp129
Public sWinTitles$
Public Const MAX_PATH = 260
Public Const LB_SETTABSTOPS As Long = &H192
Public Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Public Declare Function GetClassName Lib "user32" _
Alias "GetClassNameA" _
(ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Public Declare Function GetWindowText Lib "user32" _
Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal cch As Long) As Long
Public Declare Function GetWindowTextLength Lib "user32" _
Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Public Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Public Function EnumWindowProc(ByVal hWnd As Long, _
ByVal lParam As Long) As Long
'working vars
Dim nSize As Long
Dim sTitle As String
Dim sClass As String
Dim pos As Integer
'set up the strings to receive the class and
'window text. You could use GetWindowTextLength,
'but I'll cheat and use MAX_PATH instead.
sTitle = Space$(MAX_PATH)
sClass = Space$(MAX_PATH)
Call GetClassName(hWnd, sClass, MAX_PATH)
Call GetWindowText(hWnd, sTitle, MAX_PATH)
If (InStr(1, sClass, "XLMAIN", vbTextCompare) <> 0 Or _
InStr(1, sClass, "MS-SDIa", vbTextCompare) <> 0) And _
Trim(Replace(TrimNull(sTitle), "Microsoft Excel", "")) <> Empty Then
'strip the trailing chr$(0)'s from the strings
'returned above and add the window data to the list
If sWinTitles <> Empty Then sWinTitles = sWinTitles & ":"
sWinTitles = sWinTitles & Replace(TrimNull(sTitle), "Microsoft Excel - ", "")
End If
'to continue enumeration, we must return True
'(in C that's 1). If we wanted to stop (perhaps
'using if this as a specialized FindWindow method,
'comparing a known class and title against the
'returned values, and a match was found, we'd need
'to return False (0) to stop enumeration. When 1 is
'returned, enumeration continues until there are no
'more windows left.
EnumWindowProc = 1
End Function
Private Function TrimNull(item As String)
'remove string before the terminating null(s)
Dim pos As Integer
pos = InStr(item, Chr$(0))
If pos Then
TrimNull = Left$(item, pos - 1)
Else: TrimNull = item
End If
End Function
'''''''''''''''''''''''''' Code for your sub ''''''''''''''''''
Private Sub myroutine()
Dim arTmp
Dim arOrigWin
Dim iCount&
Dim iNewWinCount&
Dim boMatch As Boolean
Dim sNewWins$
Dim xlApp As Excel.Application
'enumerate the windows passing the AddressOf the
'callback function. This example doesn't use the
'lParam member.
Call EnumWindows(AddressOf EnumWindowProc, &H0)
arOrigWin = Split(sWinTitles, ":")
arTmp = Split(sWinTitles, ":")
iCount = UBound(arTmp)
Do Until UBound(arTmp) > iCount
'put your own wait statement here if needed
DoEvents
sWinTitles$ = Empty
Call EnumWindows(AddressOf EnumWindowProc, &H0)
If sWinTitles <> Empty Then
arTmp = Split(sWinTitles, ":")
Else
MsgBox "There are no instances of Excel detected", vbCritical
GoTo Quit
End If
Loop
MsgBox "Window count has increased from " & iCount + 1 & " to " & UBound(arTmp) + 1
Stop
For i = LBound(arTmp) To UBound(arTmp)
boMatch = False
For o = LBound(arOrigWin) To UBound(arOrigWin)
If arOrigWin(o) = arTmp(i) Then
boMatch = True
Exit For 'o
End If
Next 'o
If boMatch = False Then
'Window in question was not open before
iNewWinCount = iNewWinCount + 1
If sNewWins <> Empty Then sNewWins = sNewWins & ":"
sNewWins = sNewWins & arTmp(i)
MsgBox "New file found: " & arTmp(i) 'remark after debugging
End If
nexti:
Next 'i
Stop
If iNewWinCount = 1 Then
'This is where we want to be
Set xlApp = GetObject(sNewWins).Application
'If no error, you can now refer to the new instance
'of excel as xlapp
ElseIf iNewWinCount > 1 Then
'Hopefully this doesn't happen but if it does
'find more then 1 new window since last checked,
'put your code for handling this situation here.
'The new window names are available in sNewWins
'and are colon delimited.
Else
'No new windows?
End If
Quit:
sWinTitles = Empty
Erase arTmp
Erase arOrigWin
End Sub
