Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8400 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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 回答[未読]
【33300】ShellExecuteとCreateObject("Wscr...
質問  よっちゃん  - 06/1/8(日) 2:50 -
引用なし
パスワード
   ShellExecuteとCreateObject("Wscript.Shell")
の具体的な違いはShellExecuteがあるファイルの実行が終わらなくても
次のコードを実行するShell、CreateObject("Wscript.Shell")
があるファイルの実行が終わるまで次のコードの実行をまつ、shell
と理解しています。あるファイルを実行したいのですが
CreateObject("Wscript.Shell")
で実行するとそのファイルがなぜか完全に成功しないのです。
そこでShellExecuteだと用意したファイルが意図したとおりに動いてくれるのですが、
次のファイルをすぐ実行してしまうのでこまっています。
whileで実行をまってみますが、ちょっと重いようなきがするので
CreateObject("Wscript.Shell")のように次のコードの実行をまってくれる
別のshellコードみたいなものないものでしょうか？
【33309】Re:ShellExecuteとCreateObject("W...
発言  Kein  - 06/1/8(日) 17:39 -
引用なし
パスワード
   >ShellExecuteだと用意したファイルが意図したとおりに動いてくれる
どうせWin32API関数を使うなら、↓こちらを参考にされたら良いと思います。
http://homepage1.nifty.com/MADIA/vb/API/VBDOUKI2.htm
【33320】Re:ShellExecuteとCreateObject("W...
発言  よっちゃん  - 06/1/9(月) 4:29 -
引用なし
パスワード
   せっかく教えてもらったのですが、
これは具体的なファイルって指定できませんよね？
実行ファイルしか指定できませんよね？
具体的なファイルを指定する方法か、
他にないものでしょうか？
【33321】Re:ShellExecuteとCreateObject("W...
発言  よっちゃん  - 06/1/9(月) 4:58 -
引用なし
パスワード
   できたらShellExecute関数で同期をとることはできませんか？
【33331】Re:ShellExecuteとCreateObject("W...
回答  Kein  - 06/1/9(月) 14:19 -
引用なし
パスワード
   ↓このようなコードでテストしてみましたが、うまくいきましたよ。

Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function ShellExecute Lib "shell32" Alias _
"ShellExecuteA" (ByVal hWnd&, ByVal lpOperation$, ByVal lpFile$, _
ByVal lpParameters$, ByVal lpDirectory$, ByVal nShowCmd&) As Long
Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal PROCESS As Long, lpExitCode As Long) As Long

Const SW_SHOW = 5

Sub Test_同期処理()
　 Dim hWnd As Long, INST As Long, PROCESS As Long
　 Dim MODORITI As Long, ENDWORK As Long
　 Const F_name As String = _
　 "C:\Documents and Settings\User\My Documents\Test.txt"

　 hWnd = GetForegroundWindow()
　 INST = ShellExecute(hWnd, "Open", "Notepad.exe", F_name, "", SW_SHOW)
　 PROCESS = OpenProcess(1024 Or 1048576, True, INST)
　 Do While 1
　　　MODORITI = GetExitCodeProcess(PROCESS, ENDWORK)
　　　If ENDWORK <> 259 Then Exit Do
　 Loop
　 MsgBox "同期処理は成功しました", 64
End Sub
【33356】Re:ShellExecuteとCreateObject("W...
質問  よっちゃん  - 06/1/9(月) 17:23 -
引用なし
パスワード
   わざわざありがとうございます♪
ですが、このコードをそのまま貼り付けると
ShellExecuteがコンパイルエラーになり、
「名前が適切ではありません。」
とでます。どうしたらいいのでしょうか？
【33367】Re:ShellExecuteとCreateObject("W...
発言  Kein  - 06/1/9(月) 18:59 -
引用なし
パスワード
   >このコードをそのまま貼り付けると
当然ですが定数の宣言部分などは、そちらの環境に合わせて変更しないとダメです。
もちろん、起動したいソフトの指定も Notepad で無ければ、変更する必要が
あります。あたりまえすぎて指摘しなかっただけですが、ShellExecute関数を
使ったコードを既に試している、と解釈していたのでそのようなサンプルを提示
したのです。
【33376】Re:ShellExecuteとCreateObject("W...
発言  よっちゃん  - 06/1/10(火) 1:34 -
引用なし
パスワード
   かんちがいでした。すでに上の方で宣言しているからコンパイルエラーが
でるようでした。
これをやってみましたが。
説明がわるかったかもしれせんが、
あるプログラムを(実行ファイル）完了した時点でつぎの
コードに移りたいのですが。
これだと実行した地点でつぎのコードにいってしまいます。
これはどうにかなりませぬか？
【33382】Re:ShellExecuteとCreateObject("W...
発言  Kein  - 06/1/10(火) 12:27 -
引用なし
パスワード
   >これだと実行した地点でつぎのコードにいってしまいます
こちらでは、ちゃんとNotepad.exeの終了を待ってから、MsgBoxが出ました。
従ってこれ以上、回答できることはありません。
【33405】謎
質問  よっちゃん  - 06/1/11(水) 6:01 -
引用なし
パスワード
   ▼Kein さん：
>>これだと実行した地点でつぎのコードにいってしまいます
>こちらでは、ちゃんとNotepad.exeの終了を待ってから、MsgBoxが出ました。
>従ってこれ以上、回答できることはありません。

こちらは、何度やってもメモ帳が起動したと同時に
msgboxがでます。
なにか原因として考えられることはないですか？
【33406】Re:謎
発言  こたつねこ  - 06/1/11(水) 10:19 -
引用なし
パスワード
   よっちゃんさん、みなさんこんにちは

>>>これだと実行した地点でつぎのコードにいってしまいます
どの様なコードを実行して次のコードに行ってしまっているのですか？
もし、Keinさんが提示していただけているコードならば、その動作で
正解ですよ？
これは、プロセスが終了するまでループさせて同期を取っているので
すから･･･

>こちらは、何度やってもメモ帳が起動したと同時に
>msgboxがでます。
>なにか原因として考えられることはないですか？
よっちゃんさんが実際動作確認している環境やコードをUPされていな
いので具体的なアドバイスが難しいと思いますよ。

現在のOSやコードを明記されたほうが良いのではないでしょうか？
【33407】Re:謎
発言  awu  - 06/1/11(水) 12:05 -
引用なし
パスワード
   提示のあったコードでテストしましたが、こちらでもすぐにmsgboxがでます。

こんな感じで如何でしょうか。

Declare Function OpenProcess Lib "kernel32" _
　　(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
　　ByVal dwProcessId As Long) As Long
Declare Function GetExitCodeProcess Lib "kernel32" _
　　(ByVal PROCESS As Long, lpExitCode As Long) As Long
Declare Function CloseHandle Lib "kernel32" _
　　(ByVal hObject As Long) As Long
　　
Sub AP終了まで待機()
　 Dim PrcsID As Long, Prcs As Long
　 Dim ExitCode As Long, Rc As Long
　 Const F_name As String = "C:\Data\ファイル名.txt"
　 PrcsID = Shell("Notepad.exe " & F_name, vbNormalFocus)
　 Prcs = OpenProcess(&H400, 1, PrcsID)
　 Do
　　　　Rc = GetExitCodeProcess(Prcs, ExitCode)
　　　　DoEvents
　 Loop While ExitCode = &H103
　 Rc = CloseHandle(Prcs)
　 MsgBox "Notepad.exe が、終了しました。", vbInformation
End Sub
【33436】Re:謎
お礼  よっちゃん  - 06/1/12(木) 2:42 -
引用なし
パスワード
   ▼awu さん：
わざわざありがとうございます♪
awu さんのコードだと私の環境でもできました♪
ありがとうございました！
【33438】Re:謎
発言  こたつねこ  - 06/1/12(木) 8:53 -
引用なし
パスワード
   よっちゃんさん、こんにちは

もう無事解決されているようですが、APIを使って
ループ待ちさせない方法のサンプルをひとつ･･･

Public Declare Function CreateProcess _
　　Lib "kernel32" Alias "CreateProcessA" _
　　　　(ByVal lpApplicationName As String, _
　　　　 ByVal lpCommandLine As String, _
　　　　 lpProcessAttributes As SECURITY_ATTRIBUTES, _
　　　　 lpThreadAttributes As SECURITY_ATTRIBUTES, _
　　　　 ByVal bInheritHandles As Long, _
　　　　 ByVal dwCreationFlags As Long, _
　　　　 lpEnvironment As Any, _
　　　　 ByVal lpCurrentDriectory As String, _
　　　　 lpStartupInfo As STARTUPINFO, _
　　　　 lpProcessInformation As PROCESS_INFORMATION) As Long
　　　　
Public Declare Function WaitForSingleObject _
　　Lib "kernel32" _
　　　　(ByVal hHandle As Long, _
　　　　 ByVal dwMilliseconds As Long) As Long
　　　　
Public Declare Function CloseHandle _
　　Lib "kernel32" (ByVal hObject As Long) As Long

Public Type SECURITY_ATTRIBUTES
　　　　nLength As Long
　　　　lpSecurityDescriptor As Long
　　　　bInheritHandle As Long
End Type
Public Type PROCESS_INFORMATION
　　　　hProcess As Long
　　　　hThread As Long
　　　　dwProcessId As Long
　　　　dwThreadId As Long
End Type
Public Type STARTUPINFO
　　　　cb As Long
　　　　lpReserved As String
　　　　lpDesktop As String
　　　　lpTitle As String
　　　　dwX As Long
　　　　dwY As Long
　　　　dwXSize As Long
　　　　dwYSize As Long
　　　　dwXCountChars As Long
　　　　dwYCountChars As Long
　　　　dwFillAttribute As Long
　　　　dwFlags As Long
　　　　wShowWindow As Integer
　　　　cbReserved2 As Integer
　　　　lpReserved2 As Long
　　　　hStdInput As Long
　　　　hStdOutput As Long
　　　　hStdError As Long
End Type

Public Const STATUS_WAIT = 0&
Public Const STATUS_TIMEOUT = &H102&
Public Const STATUS_ABANDONED_WAIT = &H80&

Sub a()
　　Dim strExeFileName As String
　　Dim strCurrntDir As String
　　Dim udtProcessAttributes As SECURITY_ATTRIBUTES
　　Dim udtThradAttributes As SECURITY_ATTRIBUTES
　　Dim udtStartupInfo As STARTUPINFO
　　Dim udtProcessInfo As PROCESS_INFORMATION
　　Dim lngResult As Long
　　Dim strCommandLine As String
　　Dim lngWaitForObjectEvent As Long
　　Dim lngWaitForObjectTimeOut As Long
　　
　　strCommandLine = vbNullString
　　strCurrntDir = vbNullString
　　
　　strExeFileName = Environ("windir") & "\Notepad.exe"
　　
　　udtProcessAttributes.nLength = Len(udtProcessAttributes)
　　udtThradAttributes.nLength = Len(udtThradAttributes)
　　
　　
　　udtStartupInfo.cb = Len(udtStartupInfo)
　　
　　lngResult = CreateProcess(strExeFileName, _
　　　　　　　　　　　　　　　strCommandLine, _
　　　　　　　　　　　　　　　udtProcessAttributes, _
　　　　　　　　　　　　　　　udtThradAttributes, _
　　　　　　　　　　　　　　　False, _
　　　　　　　　　　　　　　　0, _
　　　　　　　　　　　　　　　ByVal vbNullString, _
　　　　　　　　　　　　　　　strCurrntDir, _
　　　　　　　　　　　　　　　udtStartupInfo, _
　　　　　　　　　　　　　　　udtProcessInfo)
　　
　　If lngResult <> 0 Then
　　　　lngWaitForObjectTimeOut = 300000
　　　　lngWaitForObjectEvent = WaitForSingleObject(udtProcessInfo.hProcess, lngWaitForObjectTimeOut)
　　　　
　　　　Select Case lngWaitForObjectEvent
　　　　　　Case STATUS_WAIT
　　　　　　　　MsgBox "待機終了"
　　　　　　Case STATUS_TIMEOUT
　　　　　　　　MsgBox "タイムアウト"
　　　　　　Case STATUS_ABANDONED_WAIT
　　　　　　　　MsgBox "待機失敗"
　　　　End Select
　　Else
　　　　MsgBox "プロセスを作成できません"
　　End If
　　CloseHandle udtProcessInfo.hProcess
End Sub
【33520】Re:ShellExecuteとCreateObject("W...
発言  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")
>で実行するとそのファイルがなぜか完全に成功しないのです。

私も通常はＷＳＨを使用しています。

この成功しない事例を具体的に記述していただければ
この投稿を見ている方の素晴らしい手引きになると思いますけど・・・。
・どんな種類のファイルを指定したときに成功しないのか
・WindowsやWshのバージョン等の記述。
【33523】Re:ShellExecuteとCreateObject("W...
回答  よっちゃん  - 06/1/14(土) 4:05 -
引用なし
パスワード
   ▼ichinose さん,こたつねこさん、コードの提示参考になります。

>この成功しない事例を具体的に記述していただければ
>この投稿を見ている方の素晴らしい手引きになると思いますけど・・・。
>・どんな種類のファイルを指定したときに成功しないのか
>・WindowsやWshのバージョン等の記述。

ファイルの拡張子はrocですね、ロケットマウスとういうシェアソフトで
作った奴です。
ウィンドウズはXP　ﾎｰﾑｴﾃﾞｨｼｮﾝです。WSHについてのバージョンはくわしくわかりません。
以上簡単ですが、参考まで。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8400 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free