Excel VBA質問箱 IV

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

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


48230 / 76732 ←次へ | 前へ→

【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 質問
【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 回答

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