Windows Excel [最近つかったもの] を取得したいです

Question

環境

Windows10
Excel2010

実現したいこと

あるデータベースアプリケーションから開いたExcelﾃﾞｰﾀをVBAで取得したいのですが、別のExcelApplicationとして開くため最初から開いているExcelApplicationから取得することができず困っております。（Application クラスが別のため）

試してみた事

[最近使用したﾌｧｲﾙ]のCollection からフルパスを取得できないかと思い下記のコードを試しましたが、やはり別のExcelApplicationは取得できませんでした。

Debug.Print Application.RecentFiles(1).Name

教えて頂きたいこと

下図のようにタスクバーから[最近つかったもの]であれば、別のExcelApplication　であっても表示されることが分かりました。これを取得する方法をご教示願います。API　も検索はしてみたのですが見つからず困っております。

Answer 1

質問の回答とは少し反れますが、別のインスタンスのエクセルでもGetObjectを使えば取得できますよ。

複数Excelが立ち上がっている場合は、もうちょっと厄介なコードが必要になりますが、Excelを2つ開いているわけでは無いようなのでこれでも対応出来ませんか？

エクセルが1つしか起動していない場合

'起動中のエクセルのアクティブブック名を返す関数の例
Function GetExcelBookName() As String
   Dim xlAp As Object 'Excel.Application
   Dim xlBk As Object 'Excel.Workbook
   
   Set xlAp = GetObject(, "Excel.Application")
   Set xlBk = xlAp.ActiveWorkbook
   
   GetExcelBookName = xlBk.Name
   
   Set xlBk = Nothing
   Set xlAp = Nothing
End Function

複数のエクセルプロセスに対応する場合

モジュール側（適当なモジュール名で保存）

Option Explicit

Private Declare Function EnumWindows Lib "user32.dll" _
                        (ByVal lpEnumFunc As Long, _
                         ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32.dll" _
                        Alias "GetClassNameA" _
                        (ByVal hWnd As Long, _
                         ByVal lpClassName As String, _
                         ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32.dll" _
                        (ByVal hWndParent As Long, _
                         ByVal lpEnumFunc As Long, _
                         ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll" _
                        Alias "GetWindowTextA" _
                        (ByVal hWnd As Long, _
                         ByVal lpString As String, _
                         ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" _
                        Alias "SendMessageA" _
                        (ByVal hWnd As Long, ByVal Msg As Long, _
                         ByVal wParam As Long, lParam As Any) As Long
Private Declare Function IIDFromString Lib "ole32" _
                        (lpsz As Any, lpiid As Any) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" _
                        (ByVal lResult As Long, riid As Any, _
                         ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function IsWindow Lib "user32" _
                        (ByVal hWnd As Long) As Long
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private Const OBJID_CLIENT = &HFFFFFFFC

Private Const IID_IMdcList = "{8BD21D23-EC42-11CE-9E0D-00AA006002F3}"
Private Const IID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
Private Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"

Private Const WM_GETOBJECT = &H3D&

Private Type WbkDtl
    hWndAp     As Long
    hWndWb     As Long
    xlAP        As Excel.Application
    xlWB        As Excel.Workbook
End Type
Private wD()     As WbkDtl
   
' コールバック関数
Private Function EnumWindowsProc(ByVal hWnd As Long, _
                         ByVal lParam As Long) As Long
  
    Dim strClassBuff    As String * 128
    Dim strClass        As String
    Dim lngRtnCode      As Long
    Dim lngThreadId     As Long
    Dim lngProcesID     As Long

    ' クラス名取得
    lngRtnCode = GetClassName(hWnd, strClassBuff, Len(strClassBuff))
    strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
    If strClass = "XLMAIN" Then
        ' 子ウィンドウを列挙
        lngRtnCode = EnumChildWindows(hWnd, _
                            AddressOf EnumChildSubProc, lParam)
    End If
    ' 列挙を継続
EnumPass:
    EnumWindowsProc = True
End Function

' コールバック関数 - 子ウィンドウを列挙
Private Function EnumChildSubProc(ByVal hwndChild As Long, _
                                  ByVal lParam As Long) As Long
    Dim strClassBuff    As String * 128
    Dim strClass        As String
    Dim strTextBuff     As String * 516
    Dim strText         As String
    Dim lngRtnCode      As Long
  
    ' クラス名取得
    lngRtnCode = GetClassName(hwndChild, strClassBuff, Len(strClassBuff))
    strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
    If strClass = "EXCEL7" Then
        ' テキストをバッファに
        lngRtnCode = GetWindowText(hwndChild, strTextBuff, Len(strTextBuff))
        strText = Left(strTextBuff, InStr(strTextBuff, vbNullChar) - 1)
  
        If InStr(1, strText, ".xla") = 0 Then     '
            If Sgn(wD) = 0 Then
                ReDim wD(0)
                wD(0).hWndWb = hwndChild
            Else
                ReDim Preserve wD(UBound(wD) + 1)
                wD(UBound(wD)).hWndWb = hwndChild
            End If
        End If
    End If
    ' 列挙を継続
EnumChildPass:
    EnumChildSubProc = True
End Function

Private Sub GetExcelBook(wDl As WbkDtl)
    Dim IID(0 To 3) As Long
    Dim bytID()     As Byte
    Dim lngResult   As Long
    Dim lngRtnCode As Long
    Dim wbw         As Excel.Window
  
    If IsWindow(wDl.hWndWb) = 0 Then Exit Sub
    lngResult = SendMessage(wDl.hWndWb, WM_GETOBJECT, 0, ByVal OBJID_NATIVEOM)
    If lngResult Then
        bytID = IID_IDispatch & vbNullChar
        IIDFromString bytID(0), IID(0)
        lngRtnCode = ObjectFromLresult(lngResult, IID(0), 0, wbw)
        If Not wbw Is Nothing Then
            Set wDl.xlWB = wbw.Parent
            Set wDl.xlAP = wbw.Application
            wDl.hWndAp = wbw.Application.hWnd
        End If
    End If
End Sub

'起動中のエクセルのApplicationオブジェクトの配列を返す
Public Function GetExcelApplications() As Variant
    Dim lngRtnCode As Long
    Dim i           As Long
    Dim DicApp      As Dictionary
    Dim Key         As Variant
    Dim Apps()      As Excel.Application
    
    Set DicApp = New Dictionary
    
    Erase wD
    lngRtnCode = EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
    For i = 0 To UBound(wD)
        Call GetExcelBook(wD(i))
        If Not DicApp.Exists(wD(i).hWndAp) Then
            DicApp.Add wD(i).hWndAp, wD(i).xlAP
        End If
    Next
    
    If DicApp.Count > 0 Then
        ReDim Apps(1 To DicApp.Count)
        i = 0
        For Each Key In DicApp.Keys
            i = i + 1
            Set Apps(i) = DicApp(Key)
        Next
    End If
    
    GetExcelApplications = Apps
End Function

呼び出し側（任意のモジュールに記載）

'Excel Applicationごとのアクティブワークブックの名前をイミディエイトウィンドウに出力
Sub Test_ExcelApps()
    Dim App As Variant
    For Each App In GetExcelApplications
        Debug.Print App.ActiveWorkbook.Name
    Next
End Sub

Comments

[shigeru]

Excelは２つ開いている状態のため困っております。説明が足りておらずすいません。
状況は下記の通りです

①　 [ Book_A ] を開いている　（これにコードを書きます）
②　別のExcel Application から [ Book_B ] が開く（システム上勝手に別のExcelApplicationとして開いてしまう）

この状態で [ Book_A ] から [ Book_B ] のデータを取得したい

[退会済みユーザー]

でしたら、ここのコードが参考になるかもしれません。
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=63055;id=excel
時間があれば整えたものを追記しますが、夜になると思います。

[shigeru]

ありがとうございます。
コードの実行をしてWorkbookのオブジェクトを取得できることは確認しました。
Windows API を使用してWindowﾊﾝﾄﾞﾙから検索をして取得する。ということでしょうか。まずはゆっくりコードを確認してみたいと思います。（私ではこのコード全て理解するのは無理かもしれませんが…）
もし整えたものを追記頂けましたら助かります。

[退会済みユーザー]

夜に・・・と言いましたが時間が出来たので追記しました。関数化したので中身は理解しなくても大丈夫だと思います。

[shigeru]

早速ありがとうございます！
コード実行をしてそれぞれのExcelを取得できることを確認しました！学習のために夜にもう一度じっくりコードを読みたいと思いますのでまた書込みさせて頂きます。

[shigeru]

コードを理解しようとしましたがやはり今の私では理解しきれませんでした・・・。コードの質問をするとキリがなさそうなので、すいませんが1点だけご教示いただけますでしょうか。

下記の関数は何を取得しているのですか？
’　コールバック関数
Private Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long

[退会済みユーザー]

コールバック関数については調べましたか？

Win32APIの関数では引数に関数へのポインタを持つものがあります。
今回で言うとEnumWindows関数ですね。
https://msdn.microsoft.com/ja-jp/library/cc410851.aspx

EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)の部分で、EnumWindowsにEnumWindowsProcのアドレスを渡しています。

その後F8でステップしていくと何度も何度もEnumWindowsProcが呼び出されるのが分かると思いますが、これは(VBEでは閲覧出来ないが）EnumWindows関数の中から呼び出されているのです。
「何を取得しているのですか？」の解は「トップレベルウィンドウ（のウィンドウハンドル）」ですね。

コールバック関数やAddressOfは普通にVBAを使っているうちは見かけることは無いのですが、APIでは時々見かけるので注意してくださいね。

[shigeru]

とてもご丁寧にありがとうございます。一つずつ調べながら学習したいと思います。今回は助かりました、業務の様々な場面で役立てることができそうです。
ありがとうございました。