ローカルのHTMLファイルを起動するには？ (ID：112522)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

VB6の関連付けられたアプリでオープンする方法の
サンプルモジュールですがこれでは駄目ですか？

Option Explicit

'= 関連付けられている実行可能ファイルによりファイルを
'= オープンまたは印刷する拡張関数の宣言
Declare Function ShellExecuteEx Lib "shell32.dll" _
    Alias "ShellExecuteExA" _
   (lpExecInfo As SHELLEXECUTEINFO) As Long

'= 指定されたプロセスの終了状態を取得する関数の宣言
Declare Function GetExitCodeProcess Lib "kernel32.dll" _
   (ByVal hProcess As Long, _
    lpExitCode As Long) As Long

'= オブジェクトの状態がシグナル状態あるいは
'= タイムアウト時間が経過するまで待機する関数の宣言
Declare Function WaitForInputIdle Lib "user32.dll" _
   (ByVal hProcess As Long, _
    ByVal dwMilliseconds As Long) As Long

'= 待機
Public Declare Sub Sleep Lib "kernel32" _
    (ByVal dwMilliseconds As Long)

'= オブジェクトハンドルをクローズする関数の宣言
Declare Function CloseHandle Lib "kernel32.dll" _
    (ByVal hObject As Long) As Long

'= 実行するアプリケーションの情報を定義する構造体の宣言
Type SHELLEXECUTEINFO
    cbSize        As Long
    fMask         As Long
    hWnd          As Long
    lpVerb        As String
    lpFile        As String
    lpParameters  As String
    lpDirectory   As String
    nShow         As Long
    hInstApp      As Long
    lpIDList      As Long
    lpClass       As String
    hkeyClass     As Long
    dwHotKey      As Long
    hIcon         As Long
    hProcess      As Long
End Type

'= プロセスハンドルの取得を示すマスク定数
Public Const SEE_MASK_NOCLOSEPROCESS = &H40

'= ウィンドウの表示状態を示す定数の宣言
Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3

'= プロセスの終了状態を示す定数
Public Const STATUS_PENDING = &H103&
Public Const STILL_ACTIVE = STATUS_PENDING

Public Function OpenFile(strFileName As String) As Boolean

Dim udtShellExecuteInfo As SHELLEXECUTEINFO
    Dim lngProcessExitCode  As Long
    Dim lngResult           As Long
    Dim lngInstr            As Long
    Dim lngFor              As Long

OpenFile = False

' 実行するファイルの情報を指定
    With udtShellExecuteInfo
        .cbSize = Len(udtShellExecuteInfo)
        .fMask = SEE_MASK_NOCLOSEPROCESS
        .hWnd = App.ThreadID
        .lpVerb = "open"
        .lpFile = strFileName
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = SW_SHOWNORMAL
    End With
    
    '= 関連付けられている実行可能ファイルにより印刷
    If ShellExecuteEx(udtShellExecuteInfo) <> 1 Then
        Exit Function
    End If
    
    '= 新しいプロセスを作成できたときは
    If udtShellExecuteInfo.hProcess = 0 Then
        '= エラーはシステム上で出力
        Exit Function
    End If
    
    '= 初期化待機
    If WaitForInputIdle(udtShellExecuteInfo.hProcess, 600000) <> 0 Then
        Call CloseHandle(udtShellExecuteInfo.hProcess)
        Exit Function
    End If
        
    Call CloseHandle(udtShellExecuteInfo.hProcess)
    
    OpenFile = True

End Function

←解決時は質問者本人がここをチェックしてください。

戻る