Htmlファイルの起動 ： Access

■ Access VBA 実行コード

'拡張子に関連付けられたプログラムを実行する

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 Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

Public Sub MyShellExec(sFina As String)
    Dim lRet As Long
    Dim sRet As String
    Dim vId As Variant

'sFinaで指定されたファイルを実行する
    lRet = ShellExecute(0&, vbNullString, sFina, vbNullString, vbNullString, vbNormalFocus)
    If lRet > ERROR_SUCCESS Then
        sRet = ""
    Else
'エラー内容を調査します。
        Select Case lRet
            Case ERROR_NO_ASSOC:
                vId = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                    & sFina, vbNormalFocus)
                lRet = (vId <> 0)
            Case ERROR_OUT_OF_MEM:
                sRet = "エラー：メモリーが不足しています。ファイルを開く事ができません。"
            Case ERROR_FILE_NOT_FOUND:
                sRet = "エラー:ファイルが見つかりません。"
            Case ERROR_PATH_NOT_FOUND:
                sRet = "エラー:ファイルのあるフォルダーが見つかりません"
            Case ERROR_BAD_FORMAT:
                sRet = "エラー:ファイルを読む事ができません"
            Case Else:
        End Select
    End If
    If sRet <> "" Then
'エラーが発生している場合、エラー内容のメッセージを表示します。
        sRet = sRet + vbCrLf + "(" + sFina + ")"
        Beep
        MsgBox (sRet)
    End If
End Sub

'コマンドボタンクリックイベント
Private Sub コマンド0_Click()
    MyShellExec "test.html"
End Sub