タイトル : Re^2: 実行中のACCESSファイル群のパス取得方法 投稿日 : 2010/11/26(Fri) 21:44 投稿者 : 魔界の仮面弁士
> AccApp = GetObject(, "Access.Application") '起動済みのインスタンスを取得 (中略) > なお、アプリケーション自体が複数起動されている状態においては、 > GetObject で単純に取得…というわけには行きません(Excel でも Access でも)。 > それぞれのインスタンスを取得したいようなケースにおいては、 > ROT(Running Object Table)から辿っていく必要があります。 ROT からオブジェクトを得るサンプル。 Imports System.Runtime.InteropServices.ComTypes Imports System.Runtime.InteropServices Public Class Form1 Private Declare Function GetRunningObjectTable Lib "ole32" _ (ByVal reserved As Integer, _ <Out()> ByRef pprot As IRunningObjectTable) As Integer Private Declare Function CreateBindCtx Lib "ole32" _ (ByVal reserved As Integer, _ <Out()> ByRef ppbc As IBindCtx) As Integer Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.Load Button1.Text = "更新" End Sub Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) Handles Button1.Click ListBox1.DataSource = GetROT() End Sub Private Function GetROT() As List(Of String) Dim names As New List(Of String)() Dim rot As IRunningObjectTable = Nothing Dim hr As Integer = GetRunningObjectTable(0, rot) If hr = 0 AndAlso rot IsNot Nothing Then Dim oBindCtx As IBindCtx = Nothing CreateBindCtx(0, oBindCtx) Dim oMoniker() As IMoniker = {Nothing} Dim oEnumMoniker As IEnumMoniker = Nothing rot.EnumRunning(oEnumMoniker) Do While oEnumMoniker.Next(1, oMoniker, IntPtr.Zero) = 0 Dim dispName As String = "" oMoniker(0).GetDisplayName(oBindCtx, Nothing, dispName) Marshal.ReleaseComObject(oMoniker(0)) oMoniker(0) = Nothing names.Add(dispName) Loop Marshal.ReleaseComObject(oBindCtx) oBindCtx = Nothing Marshal.ReleaseComObject(oEnumMoniker) oEnumMoniker = Nothing Marshal.ReleaseComObject(rot) rot = Nothing End If Return names End Function Private Function GetObjectFromROT(ByVal dispName As String) As Object GetObjectFromROT = Nothing Dim rot As IRunningObjectTable = Nothing Dim hr As Integer = GetRunningObjectTable(0, rot) If hr = 0 AndAlso rot IsNot Nothing Then Dim oBindCtx As IBindCtx = Nothing CreateBindCtx(0, oBindCtx) Dim oMoniker() As IMoniker = {Nothing} Dim oEnumMoniker As IEnumMoniker = Nothing rot.EnumRunning(oEnumMoniker) Do While oEnumMoniker.Next(1, oMoniker, IntPtr.Zero) = 0 Dim s As String = "" oMoniker(0).GetDisplayName(oBindCtx, Nothing, s) If s = dispName Then rot.GetObject(oMoniker(0), GetObjectFromROT) End If Marshal.ReleaseComObject(oMoniker(0)) oMoniker(0) = Nothing If s = dispName Then Exit Do End If Loop Marshal.ReleaseComObject(oBindCtx) oBindCtx = Nothing Marshal.ReleaseComObject(oEnumMoniker) oEnumMoniker = Nothing Marshal.ReleaseComObject(rot) rot = Nothing End If End Function Private Sub ListBox1_DoubleClick(ByVal sender As Object, ByVal e As EventArgs) Handles ListBox1.DoubleClick Dim dispName As String = CStr(ListBox1.SelectedItem) If MsgBox("取得します。" & vbCrLf & dispName, vbOKCancel) = vbCancel Then Return End If Dim o As Object = GetObjectFromROT(dispName) If o Is Nothing Then MsgBox("見つかりませんでした。") Else MsgBox("取得しました。" & vbCrLf & TypeName(o)) ' ' 'ここに、取得したオブジェクトに対する処理を記述。 ' ' Marshal.ReleaseComObject(o) End If End Sub End Class |