VBA Fox編
【5】ファイル名に関連付けられたファイルを開く
ファイル名のリストを表示してそれをクリックした場合に関連付けられたアプリケーションで開くには
APIを用いる。但し、EXCELに関連するものは開くことが出来なのでActiveX オブジェクトをCreateObjectで作成します。
以下にファイルのフルパスを渡すと関連したファイルを開くプロシジャーを示します。
'■APIの宣言を標準モジュールに記述する。
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" ( _
ByVal lpFile As String, ByVal lpDirectory _
As String, ByVal lpResult As String) As Long
'■以下をユーザフォームに記述し、引数でファイルのフルパスを渡します。
Private Sub 関連FOpen(a_FileP As String)
On Error GoTo ErrProc
Dim xls As Excel.Application
Dim wkb As Excel.Workbook
Dim w_Rtn As Long
Const SW_SHOW = 5 'ウィンドウを現在の位置とサイズで表示する
Dim w_ApPath As String * 512, w_Ap As String, w_ApPathS
'念のためにファイルの存在確認をする
If Dir(a_FileP) = "" Then
MsgBox "ファイルが存在性ません!", vbInformation
Exit Sub
End If
'関連付けられてアプリの格納先を取得する
w_Rtn = FindExecutable(a_FileP, 0, w_ApPath)
If w_Rtn <= 32 Then
'返り値が 32 以下の場合はエラー
MsgBox "関連付けが不明です!", vbInformation
End If
'関連付けられてアプリのファイル名を取得する
w_ApPathS = Left(w_ApPath, InStr(w_ApPath, Chr$(0)) - 1)
w_Ap = Right(w_ApPathS, Len(w_ApPathS) - InStrRev(w_ApPathS, "\"))
Select Case w_Ap
Case "EXCEL.EXE"
'EXCELの場合は新しいBOOKを開く
Set xls = CreateObject("Excel.Application")
Set wkb = xls.Workbooks.Open(Filename:=a_FileP)
Let xls.UserControl = True
Let xls.Visible = True
Case Else
'EXCELでない場合は
'WinAPIを使って関連付けられたアプリケーションを起動
w_Rtn = ShellExecute(0, "OPEN", _
a_FileP, vbNullString, CurDir(), SW_SHOW)
If w_Rtn <= 32 Then
'返り値が 32 以下の場合はエラー
MsgBox "ファイルを開けません!", vbInformation
End If
End Select
Set wkb = Nothing
Set xls = Nothing
Exit Sub
ErrProc:
MsgBox "Error番号:" & Err.Number & vbNewLine & _
"Error内容:" & Err.Description, 16, "管理者連絡"
End Sub