'Win32 API Programing NyuMon AI Shuppan Atsushi Omura 2002 'Aug 14, 2019 Programmable on Excel 2016
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
'ハンドルが子プロセスによって継承されるかどうかを指定する構造体
Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type
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 Byte
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type
Declare Function WaitForInputIdle Lib "user32" (ByVal hProcess As Long, ByVal dwMilliseconds As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Public Const STATUS_WAIT_0 = &H0&
Public Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)
'可能な限りのすべてのアクセスを指定する
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
Sub WaitForInputIdle_Sample()
Dim strApplicationName As String '実行モジュール名
Dim udtProcessAttributes As SECURITY_ATTRIBUTES
Dim udtThreadAttributes As SECURITY_ATTRIBUTES
Dim udtStartupInfo As STARTUPINFO
Dim udtProcessInfomation As PROCESS_INFORMATION
Dim lngMilliseconds As Long 'タイムアウト時間
Dim rc As Long
MsgBox "Wordを起動してユーザーが入力できる状態になるまで待機します" & Chr(13) & "待機結果はイミディエイトウィンドウで確認してください"
'実行モジュール名
'<使用しているOfficeのバージョンに応じて絶対パスを変更してください>
strApplicationName = "C:\Program Files (x86)\Microsoft Office\root\Office16\WINWORD.EXE"
'構造体のバイト数を指定
udtProcessAttributes.nLength = Len(udtProcessAttributes)
udtThreadAttributes.nLength = Len(udtThreadAttributes)
'構造体のバイト数を指定
udtStartupInfo.cb = Len(udtStartupInfo)
'新しいプロセスを作成
rc = CreateProcess(strApplicationName, vbNullString, udtProcessAttributes, udtThreadAttributes, False, 0, ByVal vbNullString, vbNullString, udtStartupInfo, udtProcessInfomation)
'待機するタイムアウト時間を無制限にする
lngMilliseconds = INFINITE
'新しいプロセスがユーザーの入力を受け付ける状態になるまで待機する
rc = WaitForInputIdle(udtProcessInfomation.hProcess, lngMilliseconds)
'待機結果を表示
Select Case rc
Case 0&
Debug.Print "入力を開始できます"
Case WAIT_TIMEOUT
Debug.Print "指定した時間が経過しました"
Case -1&
Debug.Print "関数の呼び出しに失敗しました"
End Select
End Sub
J1dpbjMyIEFQSSBQcm9ncmFtaW5nIE55dU1vbiBBSSBTaHVwcGFuIEF0c3VzaGkgT211cmHjgIAyMDAyICdBdWcgMTQsIDIwMTkgIFByb2dyYW1tYWJsZSBvbiBFeGNlbCAyMDE2CgpUeXBlIFNFQ1VSSVRZX0FUVFJJQlVURVMKICAgIG5MZW5ndGggQXMgTG9uZwogICAgbHBTZWN1cml0eURlc2NyaXB0b3IgQXMgTG9uZwogICAgYkluaGVyaXRIYW5kbGUgQXMgTG9uZwpFbmQgVHlwZQon44OP44Oz44OJ44Or44GM5a2Q44OX44Ot44K744K544Gr44KI44Gj44Gm57aZ5om/44GV44KM44KL44GL44Gp44GG44GL44KS5oyH5a6a44GZ44KL5qeL6YCg5L2TClR5cGUgUFJPQ0VTU19JTkZPUk1BVElPTgogICAgaFByb2Nlc3MgQXMgTG9uZwogICAgaFRocmVhZCBBcyBMb25nCiAgICBkd1Byb2Nlc3NJZCBBcyBMb25nCiAgICBkd1RocmVhZElkIEFzIExvbmcKRW5kIFR5cGUKVHlwZSBTVEFSVFVQSU5GTwogICAgY2IgQXMgTG9uZwogICAgbHBSZXNlcnZlZCBBcyBTdHJpbmcKICAgIGxwRGVza3RvcCBBcyBTdHJpbmcKICAgIGxwVGl0bGUgQXMgU3RyaW5nCiAgICBkd1ggQXMgTG9uZwogICAgZHdZIEFzIExvbmcKICAgIGR3WFNpemUgQXMgTG9uZwogICAgZHdZU2l6ZSBBcyBMb25nCiAgICBkd1hDb3VudENoYXJzIEFzIExvbmcKICAgIGR3WUNvdW50Q2hhcnMgQXMgTG9uZwogICAgZHdGaWxsQXR0cmlidXRlIEFzIExvbmcKICAgIGR3RmxhZ3MgQXMgTG9uZwogICAgd1Nob3dXaW5kb3cgQXMgSW50ZWdlcgogICAgY2JSZXNlcnZlZDIgQXMgSW50ZWdlcgogICAgbHBSZXNlcnZlZDIgQXMgQnl0ZQogICAgaFN0ZElucHV0IEFzIExvbmcKICAgIGhTdGRPdXRwdXQgQXMgTG9uZwogICAgaFN0ZEVycm9yIEFzIExvbmcKRW5kIFR5cGUKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgCkRlY2xhcmUgRnVuY3Rpb24gV2FpdEZvcklucHV0SWRsZSBMaWIgInVzZXIzMiIgKEJ5VmFsIGhQcm9jZXNzIEFzIExvbmcsIEJ5VmFsIGR3TWlsbGlzZWNvbmRzIEFzIExvbmcpIEFzIExvbmcKCkRlY2xhcmUgRnVuY3Rpb24gV2FpdEZvclNpbmdsZU9iamVjdCBMaWIgImtlcm5lbDMyIiAoQnlWYWwgaEhhbmRsZSBBcyBMb25nLCBCeVZhbCBkd01pbGxpc2Vjb25kcyBBcyBMb25nKSBBcyBMb25nClB1YmxpYyBDb25zdCBTVEFUVVNfV0FJVF8wID0gJkgwJgpQdWJsaWMgQ29uc3QgV0FJVF9PQkpFQ1RfMCA9ICgoU1RBVFVTX1dBSVRfMCkgKyAwKQogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAn5Y+v6IO944Gq6ZmQ44KK44Gu44GZ44G544Gm44Gu44Ki44Kv44K744K544KS5oyH5a6a44GZ44KLCkRlY2xhcmUgRnVuY3Rpb24gQ3JlYXRlUHJvY2VzcyBMaWIgImtlcm5lbDMyIiBBbGlhcyAiQ3JlYXRlUHJvY2Vzc0EiIChCeVZhbCBscEFwcGxpY2F0aW9uTmFtZSBBcyBTdHJpbmcsIEJ5VmFsIGxwQ29tbWFuZExpbmUgQXMgU3RyaW5nLCBscFByb2Nlc3NBdHRyaWJ1dGVzIEFzIFNFQ1VSSVRZX0FUVFJJQlVURVMsIGxwVGhyZWFkQXR0cmlidXRlcyBBcyBTRUNVUklUWV9BVFRSSUJVVEVTLCBCeVZhbCBiSW5oZXJpdEhhbmRsZXMgQXMgTG9uZywgQnlWYWwgZHdDcmVhdGlvbkZsYWdzIEFzIExvbmcsIGxwRW52aXJvbm1lbnQgQXMgQW55LCBCeVZhbCBscEN1cnJlbnREcmllY3RvcnkgQXMgU3RyaW5nLCBscFN0YXJ0dXBJbmZvIEFzIFNUQVJUVVBJTkZPLCBscFByb2Nlc3NJbmZvcm1hdGlvbiBBcyBQUk9DRVNTX0lORk9STUFUSU9OKSBBcyBMb25nCgoKU3ViIFdhaXRGb3JJbnB1dElkbGVfU2FtcGxlKCkKICAgIERpbSBzdHJBcHBsaWNhdGlvbk5hbWUgQXMgU3RyaW5nICAgICflrp/ooYzjg6Ljgrjjg6Xjg7zjg6vlkI0KICAgIERpbSB1ZHRQcm9jZXNzQXR0cmlidXRlcyBBcyBTRUNVUklUWV9BVFRSSUJVVEVTCiAgICBEaW0gdWR0VGhyZWFkQXR0cmlidXRlcyBBcyBTRUNVUklUWV9BVFRSSUJVVEVTCiAgICBEaW0gdWR0U3RhcnR1cEluZm8gQXMgU1RBUlRVUElORk8KICAgIERpbSB1ZHRQcm9jZXNzSW5mb21hdGlvbiBBcyBQUk9DRVNTX0lORk9STUFUSU9OCiAgICBEaW0gbG5nTWlsbGlzZWNvbmRzIEFzIExvbmcgICAgICAgICAn44K/44Kk44Og44Ki44Km44OI5pmC6ZaTCiAgICBEaW0gcmMgQXMgTG9uZwogICAgCiAgICBNc2dCb3ggIldvcmTjgpLotbfli5XjgZfjgabjg6bjg7zjgrbjg7zjgYzlhaXlipvjgafjgY3jgovnirbmhYvjgavjgarjgovjgb7jgaflvoXmqZ/jgZfjgb7jgZkiICYgQ2hyKDEzKSAmICLlvoXmqZ/ntZDmnpzjga/jgqTjg5/jg4fjgqPjgqjjgqTjg4jjgqbjgqPjg7Pjg4njgqbjgafnorroqo3jgZfjgabjgY/jgaDjgZXjgYQiCiAgICAgICAgCiAgICAn5a6f6KGM44Oi44K444Ol44O844Or5ZCNCiAgICAnPOS9v+eUqOOBl+OBpuOBhOOCi09mZmljZeOBruODkOODvOOCuOODp+ODs+OBq+W/nOOBmOOBpue1tuWvvuODkeOCueOCkuWkieabtOOBl+OBpuOBj+OBoOOBleOBhD4KICAgIHN0ckFwcGxpY2F0aW9uTmFtZSA9ICJDOlxQcm9ncmFtIEZpbGVzICh4ODYpXE1pY3Jvc29mdCBPZmZpY2Vccm9vdFxPZmZpY2UxNlxXSU5XT1JELkVYRSIKCiAgICAn5qeL6YCg5L2T44Gu44OQ44Kk44OI5pWw44KS5oyH5a6aCiAgICB1ZHRQcm9jZXNzQXR0cmlidXRlcy5uTGVuZ3RoID0gTGVuKHVkdFByb2Nlc3NBdHRyaWJ1dGVzKQogICAgdWR0VGhyZWFkQXR0cmlidXRlcy5uTGVuZ3RoID0gTGVuKHVkdFRocmVhZEF0dHJpYnV0ZXMpCiAgICAKICAgICfmp4vpgKDkvZPjga7jg5DjgqTjg4jmlbDjgpLmjIflrpoKICAgIHVkdFN0YXJ0dXBJbmZvLmNiID0gTGVuKHVkdFN0YXJ0dXBJbmZvKQogICAgCiAgICAn5paw44GX44GE44OX44Ot44K744K544KS5L2c5oiQCiAgICByYyA9IENyZWF0ZVByb2Nlc3Moc3RyQXBwbGljYXRpb25OYW1lLCB2Yk51bGxTdHJpbmcsIHVkdFByb2Nlc3NBdHRyaWJ1dGVzLCB1ZHRUaHJlYWRBdHRyaWJ1dGVzLCBGYWxzZSwgMCwgQnlWYWwgdmJOdWxsU3RyaW5nLCB2Yk51bGxTdHJpbmcsIHVkdFN0YXJ0dXBJbmZvLCB1ZHRQcm9jZXNzSW5mb21hdGlvbikKICAgICAgICAgICAgICAgICAgICAgICAgCiAgICAn5b6F5qmf44GZ44KL44K/44Kk44Og44Ki44Km44OI5pmC6ZaT44KS54Sh5Yi26ZmQ44Gr44GZ44KLCiAgICBsbmdNaWxsaXNlY29uZHMgPSBJTkZJTklURQogICAgCiAgICAn5paw44GX44GE44OX44Ot44K744K544GM44Om44O844K244O844Gu5YWl5Yqb44KS5Y+X44GR5LuY44GR44KL54q25oWL44Gr44Gq44KL44G+44Gn5b6F5qmf44GZ44KLCiAgICByYyA9IFdhaXRGb3JJbnB1dElkbGUodWR0UHJvY2Vzc0luZm9tYXRpb24uaFByb2Nlc3MsIGxuZ01pbGxpc2Vjb25kcykKICAgICAgICAgICAgICAgICAgICAgICAgICAgIAogICAgJ+W+heapn+e1kOaenOOCkuihqOekugogICAgU2VsZWN0IENhc2UgcmMKICAgICAgICBDYXNlIDAmCiAgICAgICAgICAgIERlYnVnLlByaW50ICLlhaXlipvjgpLplovlp4vjgafjgY3jgb7jgZkiCiAgICAgICAgQ2FzZSBXQUlUX1RJTUVPVVQKICAgICAgICAgICAgRGVidWcuUHJpbnQgIuaMh+WumuOBl+OBn+aZgumWk+OBjOe1jOmBjuOBl+OBvuOBl+OBnyIKICAgICAgICBDYXNlIC0xJgogICAgICAgICAgICBEZWJ1Zy5QcmludCAi6Zai5pWw44Gu5ZG844Gz5Ye644GX44Gr5aSx5pWX44GX44G+44GX44GfIgogICAgRW5kIFNlbGVjdApFbmQgU3ViCgoK