| タイトル | ： Re^2: 実行中のACCESSファイル群のパス取得方法 |
| 記事No | ： 10324 |
| 投稿日 | ： 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
|