tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]　 [ワード検索]　 [Home]

タイトル ： 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
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

古いスレッドにレスはつけられません。