| ■84951 / ) |
Re[1]: VB.NETより、EXCELファイルを開く |
□投稿者/ 魔界の仮面弁士 (1396回)-(2017/08/24(Thu) 18:37:29)
|
■No84930 (やま さん) に返信
> 下記コードで、EXCELファイルを立ち上げています
最初の質問がごっそり削られているようですが、
『Excel ファイルを開きたいが、既に開いていたら何もしない』
という処理とみなして、とりあえずこんな感じ。
Option Strict On
Imports Excel = Microsoft.Office.Interop.Excel
Imports System.IO
Imports System.Runtime.InteropServices.ComTypes
Imports System.Runtime.InteropServices
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
If Not File.Exists(TextBox1.Text) Then
MsgBox("Excel ファイル名が指定されていません")
Return
End If
Dim found As Boolean = False
For Each app In GetExcels()
Dim books = app.Workbooks
Dim n As Integer = 1
While n <= books.Count
Dim book As Excel.Workbook = Nothing
Try
book = books(n)
If String.Compare(TextBox1.Text, book.FullName, False) = 0 Then
found = True
Exit For
End If
Finally
Marshal.ReleaseComObject(book)
End Try
n += 1
End While
Marshal.ReleaseComObject(books)
Next
If found Then
MsgBox("既に開かれていました")
Else
MsgBox("新たに開きます")
'Excel.Application のインスタンスから Workbooks.Open する手もあるけれど
'ただ開くだけならばこれで十分
Process.Start(TextBox1.Text)
End If
End Sub
Friend Iterator Function GetExcels() As IEnumerable(Of Excel.Application)
Dim rot As IRunningObjectTable = Nothing
Dim oEnumMoniker As IEnumMoniker = Nothing
Dim oBindCtx As IBindCtx = Nothing
Try
GetRunningObjectTable(0, rot)
CreateBindCtx(0, oBindCtx)
rot.EnumRunning(oEnumMoniker)
Dim oMoniker As IMoniker() = {Nothing}
Do While oEnumMoniker.Next(1, oMoniker, IntPtr.Zero) = 0
Dim unk As Object = Nothing
rot.GetObject(oMoniker(0), unk)
Dim app = TryCast(unk, Excel.Application)
If app IsNot Nothing Then
Yield app
Marshal.ReleaseComObject(app)
End If
Dim m As Integer = Marshal.ReleaseComObject(oMoniker(0))
Loop
Finally
If oBindCtx IsNot Nothing Then
Marshal.ReleaseComObject(oBindCtx)
End If
If oEnumMoniker IsNot Nothing Then
Marshal.ReleaseComObject(oEnumMoniker)
End If
If rot IsNot Nothing Then
Marshal.ReleaseComObject(rot)
End If
End Try
End Function
<DllImport("ole32", PreserveSig:=True, SetLastError:=True)>
Private Shared Sub GetRunningObjectTable(reserved As Integer, <Out()> ByRef pprot As IRunningObjectTable)
End Sub
<DllImport("ole32", PreserveSig:=True, SetLastError:=True)>
Private Shared Sub CreateBindCtx(reserved As Integer, <Out()> ByRef ppbc As IBindCtx)
End Sub
End Class
|
|
