|
皆さん、こんばんは。
GetExitCodeProcessは私も以前に使用したことがあったので
興味深くみていたのですが・・・。
ShellExecuteではなく、ShellExecuteEXを使ってみました。
標準モジュールに
'===========================================================
Public Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Public Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String _
, ByVal lpWindowName As String) As Long
Declare Function ShellExecuteEX Lib "shell32.dll" _
Alias "ShellExecuteEx" (lpExecInfo As SHELLEXECUTEINFO) As Long
Public Const SW_SHOW = 5
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Public Const APIerror = 32
Public 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
'==================================================================
Function sync_open_file(f_path As String) As Long
'指定されたファイルを関連付けられたアプリで起動する
'input f_path --- ファイルのフルパス
' out sync_open_file ---33以上 正常終了 32以下エラー
Dim ShellInfo As SHELLEXECUTEINFO
Dim hWnd As Long
Dim lngWstyle As Long
Dim dwProcessID As Long
Dim lpdwExitCode As Long
Dim ans As Long
hWnd = Application.hWnd 'excel2002以上
'hWnd = FindWindow("XLMAIN", Application.Caption) ←excel2000
With ShellInfo
.cbSize = Len(ShellInfo)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_FLAG_NO_UI
.hWnd = hWnd
.lpVerb = "open" & vbNullChar
.lpFile = f_path & vbNullChar
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = SW_SHOW
.hInstApp = 0
.lpIDList = 0
lpdwExitCode = 0
Call ShellExecuteEX(ShellInfo)
If .hInstApp > APIerror Then
Do
ret = GetExitCodeProcess(.hProcess, lpdwExitCode)
' doevents ←お好みで
Loop While lpdwExitCode
End If
sync_open_file = .hInstApp
End With
End Function
別の標準モジュールに
'===============================================
Sub test()
Call sync_open_file("D:\EXCELファイル\copyright.txt")
' 起動するファイルのフルパス
' もちろん、関連付けがされているという条件です
AppActivate Application.Caption
MsgBox "ok"
End Sub
尚、ShellExecuteEXは、
http://hp.vector.co.jp/authors/VA024411/vbtips02.html
これを参考にしました。
Win98+Excel2000 Win2000+Excel2002で確認しました。
試してみてください。
話は変わりますが、このご質問の・・・・
>ShellExecuteとCreateObject("Wscript.Shell")
>の具体的な違いはShellExecuteがあるファイルの実行が終わらなくても
>次のコードを実行するShell、CreateObject("Wscript.Shell")
>があるファイルの実行が終わるまで次のコードの実行をまつ、shell
>と理解しています。あるファイルを実行したいのですが
>CreateObject("Wscript.Shell")
>で実行するとそのファイルがなぜか完全に成功しないのです。
私も通常はWSHを使用しています。
この成功しない事例を具体的に記述していただければ
この投稿を見ている方の素晴らしい手引きになると思いますけど・・・。
・どんな種類のファイルを指定したときに成功しないのか
・WindowsやWshのバージョン等の記述。
|
|