Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


48149 / 76732 ←次へ | 前へ→

【33520】Re:ShellExecuteとCreateObject("Wscript.Shell")
発言  ichinose  - 06/1/13(金) 19:49 -

引用なし
パスワード
   皆さん、こんばんは。

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のバージョン等の記述。
1 hits

【33300】ShellExecuteとCreateObject("Wscript.Shell") よっちゃん 06/1/8(日) 2:50 質問
【33309】Re:ShellExecuteとCreateObject("Wsc... Kein 06/1/8(日) 17:39 発言
【33320】Re:ShellExecuteとCreateObject("Wsc... よっちゃん 06/1/9(月) 4:29 発言
【33321】Re:ShellExecuteとCreateObject("Wsc... よっちゃん 06/1/9(月) 4:58 発言
【33331】Re:ShellExecuteとCreateObject("Wsc... Kein 06/1/9(月) 14:19 回答
【33356】Re:ShellExecuteとCreateObject("Wsc... よっちゃん 06/1/9(月) 17:23 質問
【33367】Re:ShellExecuteとCreateObject("Wsc... Kein 06/1/9(月) 18:59 発言
【33376】Re:ShellExecuteとCreateObject("Wsc... よっちゃん 06/1/10(火) 1:34 発言
【33382】Re:ShellExecuteとCreateObject("Wsc... Kein 06/1/10(火) 12:27 発言
【33405】謎 よっちゃん 06/1/11(水) 6:01 質問
【33406】Re:謎 こたつねこ 06/1/11(水) 10:19 発言
【33407】Re:謎 awu 06/1/11(水) 12:05 発言
【33436】Re:謎 よっちゃん 06/1/12(木) 2:42 お礼
【33438】Re:謎 こたつねこ 06/1/12(木) 8:53 発言
【33520】Re:ShellExecuteとCreateObject("Wsc... ichinose 06/1/13(金) 19:49 発言
【33523】Re:ShellExecuteとCreateObject("Wsc... よっちゃん 06/1/14(土) 4:05 回答

48149 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free