Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

48235 / 76737

←次へ　｜　前へ→


	【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

0 hits

▼

【33300】ShellExecuteとCreateObject("Wscript.Shell") よっちゃん 06/1/8(日) 2:50