|
よっちゃんさん、こんにちは
もう無事解決されているようですが、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
|
|