● ファイルを開くアプリケーションの選択ダイアログを表示する ●

ShellExecute で使用すればいいんじゃない。

Private 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

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Const SE_ERR_NOASSOC = 31

'---------------------------------------------------------------------------
' 関数名 : ExecuteFile
' 機能 : ファイルを開く
' 引数 : (in) hWnd … フォームのウインドウハンドル
'          (in)FileName … ファイルのフルパス
' 返り値 : なし
' 備考 : 実行ファイルに関連付けされていないファイルを開こうとしたら、
'          ファイルをく開アプリケーションの選択ダイアログを表示する
'---------------------------------------------------------------------------
Public Sub ExecuteFile(ByVal hWnd As Long, ByVal FileName As String)

    Dim ret As Long
    Dim SystemDirBuff As String * 256
    Dim SystemDir As String

    'ファイル実行
    ret = ShellExecute(hWnd, "OPEN", FileName, vbNullString, vbNullString, vbNormalFocus)

    'エラー
    If ret < 32 Then
        If ret = SE_ERR_NOASSOC Then
            'Systemディレクトリを取得する
            Call GetSystemDirectory(SystemDirBuff, Len(SystemDirBuff))

            'NULLを取り除く
            SystemDir = Left$(SystemDirBuff, InStr(SystemDirBuff, Chr$(0)) - 1)

            'ファイルをく開アプリケーションの選択ダイアログを表示する
            Call ShellExecute(hWnd, vbNullString, "RUNDLL32.EXE", _
                     "Shell32.dll,OpenAs_RunDLL " amp&; FileName, SystemDir, vbNormalFocus)
        End If
    End If

End Sub

"OpenAs_RunDLL" はこの文字列通りにしないとエラーが発生する。1つでも、大文字が小文字、または小文字が大文字になってはいけない。例えば、"OPENAS_RUNDLL" と指定するとエラーが発生してしまう。


戻る