いろいろ試してみたところ、New Application で作ったものだけではなく
Shell 関数で起動してプロセス ID からウィンドウハンドルを取得、
ウィンドウハンドルを Excel オブジェクトに変換した場合も同様の症状でした。
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long
Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr
Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare PtrSafe Sub AccessibleObjectFromWindow Lib "OLEACC.DLL" (ByVal hWnd As LongPtr, ByVal dwId As Long, riid As GUID, ppvObject As Any)
' 次のウィンドウ
Const GW_HWNDNEXT As Long = 2
' GUID を定義
Private Type GUID
lData1 As Long
iData2 As Integer
iData3 As Integer
aBData4(0 To 7) As Byte
End Type
Private Const OBJID_NATIVEOM = &HFFFFFFF0
' IDispatch を設定
Private Sub SetIDispatch(ByRef ID As GUID)
With ID
.lData1 = &H20400
.iData2 = &H0
.iData3 = &H0
.aBData4(0) = &HC0
.aBData4(1) = &H0
.aBData4(2) = &H0
.aBData4(3) = &H0
.aBData4(4) = &H0
.aBData4(5) = &H0
.aBData4(6) = &H0
.aBData4(7) = &H46
End With
End Sub
' ウィンドウハンドルから Excel オブジェクトを取得する
Function GetXLApp(hWnd As LongPtr) As Application
Dim hXlWnd As LongPtr
Dim IDispatch As GUID
Dim oWnd As Object
' Excel のウィンドウハンドルから Excel ワークブックのウィンドウを取得し
' Excel オブジェクトに変換する
hXlWnd = FindWindowEx(FindWindowEx(hWnd, 0, "XLDESK", vbNullString), 0, "EXCEL7", vbNullString)
If hXlWnd <> 0 Then
SetIDispatch IDispatch
' Excel オブジェクトの取得
AccessibleObjectFromWindow hXlWnd, OBJID_NATIVEOM, IDispatch, oWnd
' オブジェクトの型が Window の場合は成功
If TypeName(oWnd) = "Window" Then
Set GetXLApp = oWnd.Application
End If
End If
End Function
Sub test()
Dim p As Long
Dim hWnd As LongPtr
Dim pID As Double
Dim cname As String, cpt As String
Dim xlApp As Application
Dim d As String
' 自分のワークブックパスを取得
d = ThisWorkbook.Path
' Excel を別のインスタンスで起動してプロセス ID を取得
pID = Shell("excel.exe /x /r """ & d & "\test1.xlsx""")
' 約 2 秒待機
Application.Wait DateAdd("s", 2, Now)
' 起動中の Excel のウィンドウを取得する (取得されるウィンドウは不定)
hWnd = FindWindowEx(0, 0, "xlmain", vbNullString)
' 自分のウィンドウを取得するまでループ
Do Until ThisWorkbook.Windows(1).hWnd = hWnd
' クレス名を取得する変数を初期化
cname = String(100, vbNullChar)
' クラス名を取得
GetClassName hWnd, cname, 99
' クラス名の後ろのゴミを除去
For i = 1 To Len(cname)
If Asc(Mid(cname, i, 1)) = 0 Then
Exit For
End If
Next
cname = LCase$(Left$(cname, i - 1))
' Excel のウィンドウの場合に処理
If cname = "xlmain" Then
' ウィンドウからプロセス ID を取得
GetWindowThreadProcessId hWnd, p
' 起動した Excel のプロセス ID と同じだったらループを抜ける
If pID = p Then
Exit Do
End If
End If
' 次のウィンドウを取得してループ
hWnd = GetWindow(hWnd, GW_HWNDNEXT)
DoEvents
Loop
' ウィンドウハンドルから Excel オブジェクトを取得
Set xlApp = GetXLApp(hWnd)
If Not xlApp Is Nothing Then
' ファイルをオープンしてウィンドウ表示 (落ちる)
xlApp.Workbooks.Open(d & "\test2.xlsx", , True).Windows(1).Visible = True
End If
End Sub
