編集履歴

回答編集履歴

追記３のコードスリム化

2021/07/13 09:29

投稿

スコア1065

answer CHANGED Viewed

@@ -91,15 +91,12 @@
 End Sub
 Private Sub Sousa(ByRef ie)
-    Dim htmlDoc
-    Set htmlDoc = ie.document 'objIEで読み込まれているHTMLドキュメントをセット
     Dim objTag 'IHTMLElementCollectionオブジェクト
-    For Each objTag In htmlDoc.getElementsByTagName("input")
+    For Each objTag In ie.document.getElementsByTagName("input")
         If InStr(objTag.outerHTML, "★ボタン名★") > 0 Then
             objTag.Click 'ボタンクリック
             'タイヤログ操作成功時にVBScriptが制御不可。VBAは ie.Busy = True　が成立。
-            Exit Function
+            Exit Sub
         End If
     Next
 End Sub

誤記再修正

2021/07/13 09:29

投稿

TanakaHiroaki

スコア1065

answer CHANGED Viewed

@@ -118,7 +118,6 @@
         WScript.Sleep 200
         If (Timer - RepeatSec) > 30 Then
             If ie.readyState = 4 Then
-                OutputWarn "IE Busy In vbs.IEWaitReady"
                 Exit Do
             Else
                 MsgBox "サーバーが応答していません。"

誤記修正

2021/07/13 09:20

投稿

TanakaHiroaki

スコア1065

answer CHANGED Viewed

@@ -51,7 +51,7 @@
         Sleep 100
     Loop
 ```
-＜追記２＞
+＜追記３＞
 IE操作してダイアログ表示させる IEbotton.vbs のコードです。
 ```VBScript
 '同一フォルダに`~.vbs`という名前でテキストファイルを作成し、以下のコードを記述して保存しておく。

VBScriptのコード追加

2021/07/13 09:17

投稿

TanakaHiroaki

スコア1065

answer CHANGED Viewed

@@ -50,4 +50,98 @@
         If Now > timeOut Then End '★VBScriptタイヤログ操作失敗と判断
         Sleep 100
     Loop
+```
+＜追記２＞
+IE操作してダイアログ表示させる IEbotton.vbs のコードです。
+```VBScript
+'同一フォルダに`~.vbs`という名前でテキストファイルを作成し、以下のコードを記述して保存しておく。
+'文字のエンコーディングはShift_JISまたはUnicode(UTF16LE)であること。
+Option Explicit
+Private Const TIME_MINIMUMWAIT = 1500
+Private Const TIME_MAXIMUMWAIT = 3000
+Call Main
+Public Sub Main()
+    Dim cnt         'As Long
+    Dim objW        'As Object
+    Dim sWindowName 'As String
+    For Cnt = WScript.CreateObject("Shell.Application").Windows.Count To 1 Step -1
+        Set objW = WScript.CreateObject("Shell.Application").Windows(cnt - 1)
+        If objW Is Nothing Then
+        Else
+            sWindowName = ""
+            On Error Resume Next
+            sWindowName = objW.FullName
+            On Error GoTo 0
+            If LCase(Right(sWindowName, 12)) = "iexplore.exe" Then
+                If InStr(objW.document.Title, "★操作したいIEページタイトル★") > 0 Then
+                    Call Sousa(objW)
+                End If
+            End If
+        End If
+    Next
+    Set objW = Nothing
+    Set Debug = Nothing
+    Set Logger = Nothing
+End Sub
+Private Sub Sousa(ByRef ie)
+    Dim htmlDoc
+    Set htmlDoc = ie.document 'objIEで読み込まれているHTMLドキュメントをセット
+    Dim objTag 'IHTMLElementCollectionオブジェクト
+    For Each objTag In htmlDoc.getElementsByTagName("input")
+        If InStr(objTag.outerHTML, "★ボタン名★") > 0 Then
+            objTag.Click 'ボタンクリック
+            'タイヤログ操作成功時にVBScriptが制御不可。VBAは ie.Busy = True　が成立。
+            Exit Function
+        End If
+    Next
+End Sub
+Private Sub IENavigate(ByRef ie, ByVal url)
+    ie.Visible = True
+    ie.navigate url
+    Call IEWaitReady(ie)
+    Call IEWaitRandom
+End Sub
+Private Sub IEWaitReady(ByRef ie)
+    Dim RepeatSec
+    RepeatSec = Timer
+    Do While ie.Busy = True Or ie.readyState < 4
+        WScript.Sleep 200
+        If (Timer - RepeatSec) > 30 Then
+            If ie.readyState = 4 Then
+                OutputWarn "IE Busy In vbs.IEWaitReady"
+                Exit Do
+            Else
+                MsgBox "サーバーが応答していません。"
+                ie.Quit
+            End If
+        End If
+    Loop
+    RepeatSec = Timer
+    Do While ie.document.readyState <> "complete"
+        WScript.Sleep 200
+        If (Timer - RepeatSec) > 5 Then
+            Exit Do
+        End If
+    Loop
+End Sub
+Private Sub IEWaitRandom()
+    Dim milliseconds
+    milliseconds = -1
+    Do While milliseconds < TIME_MINIMUMWAIT
+        milliseconds = Int(Rnd * TIME_MAXIMUMWAIT)
+    Loop
+    WScript.Sleep milliseconds
+End Sub
 ```

誤記修正

2021/07/13 09:16

投稿

TanakaHiroaki

スコア1065

answer CHANGED Viewed

@@ -37,7 +37,7 @@
     TaskId = Shell("WScript.exe " & ThisWorkbook.Path & """\IEbotton.vbs""")
     timeOut = Now + TimeSerial(0, 0, 10)
     Do
-        If ie.Busy = True Then '★VBScriptによるタイヤログ操作成功時にTrue
+        If ie.Busy = True Then '★VBScriptタイヤログ操作成功時Trueとなる
             Sleep 500
             'VBScriptの処理を強制終了
             hProc = OpenProcess(PROCESS_ALL_ACCESS, 0, TaskId)
@@ -47,7 +47,7 @@
             Call OK_Click 'クリック
             Exit Do
         End If
-        If Now > timeOut Then End '★VBScriptによるによるタイヤログ操作失敗
+        If Now > timeOut Then End '★VBScriptタイヤログ操作失敗と判断
         Sleep 100
     Loop
 ```

プロシージャ呼出をCallに統一

2021/07/12 13:08

投稿

TanakaHiroaki

スコア1065

answer CHANGED Viewed

@@ -41,8 +41,8 @@
             Sleep 500
             'VBScriptの処理を強制終了
             hProc = OpenProcess(PROCESS_ALL_ACCESS, 0, TaskId)
-            If hProc <> 0& Then   'プロセスハンドルが返されたかを判定
+            If hProc <> 0& Then         'プロセスハンドルが返されたかを判定
-                CloseHandle hProc 'プロセスクローズ
+                Call CloseHandle(hProc) 'プロセスクローズ
             End If
             Call OK_Click 'クリック
             Exit Do

VBScript起動から終了とOKボタンクリックのコード追加

2021/07/12 13:05

投稿

TanakaHiroaki

スコア1065

answer CHANGED Viewed

@@ -28,4 +28,26 @@
     Call SendMessage(hButton, &H6, 1, 0&)  'ボタンをアクティブにする
     Call SendMessage(hButton, &HF5, 0, 0&) 'ボタンをクリックする
 End Sub
+```
+＜追記２＞
+VBScript起動から終了とOKボタンクリックのコードです。
+```VBA
+'（WinAPI宣言部は省略）
+    '★VBScriptを起動
+    TaskId = Shell("WScript.exe " & ThisWorkbook.Path & """\IEbotton.vbs""")
+    timeOut = Now + TimeSerial(0, 0, 10)
+    Do
+        If ie.Busy = True Then '★VBScriptによるタイヤログ操作成功時にTrue
+            Sleep 500
+            'VBScriptの処理を強制終了
+            hProc = OpenProcess(PROCESS_ALL_ACCESS, 0, TaskId)
+            If hProc <> 0& Then   'プロセスハンドルが返されたかを判定
+                CloseHandle hProc 'プロセスクローズ
+            End If
+            Call OK_Click 'クリック
+            Exit Do
+        End If
+        If Now > timeOut Then End '★VBScriptによるによるタイヤログ操作失敗
+        Sleep 100
+    Loop
 ```

WinAPIを用いたVBAコードを追記

2021/07/12 12:53

投稿

TanakaHiroaki

スコア1065

answer CHANGED Viewed

@@ -3,4 +3,29 @@
 VBAからVBScriptを呼出し、VBScriptからIE操作してダイアログ表示させ、VBAで待機時間を入れて「OK」クリックするといったマルチスレッドを実装する必要がありそうです。
 参考QA
-https://teratail.com/questions/253981?link=qa_related_pc
+https://teratail.com/questions/253981?link=qa_related_pc
+＜追記＞
+①②ともに、VBAからの「OK」クリックは、WinAPIを使用します。
+参考までに私が使っているコードを紹介します。
+```VBA
+'（WinAPI宣言部は省略）
+Public Sub OK_Click() 'クリック
+    hWindow = FindWindow("#32770", "Web ページからのメッセージ")
+    If hWindow <> 0& Then
+        Call OK_Button
+    End If
+End Sub
+Private Sub OK_Button()
+    hButton = FindWindowEx(hWindow, 0&, "Button", "OK")
+    Do Until IsWindowEnabled(hButton) = 1
+        If hButton = 0& Then
+            Debug.Print "OKボタン喪失:VBA継続"
+            Exit Sub
+        End If
+    Loop
+    Call SendMessage(hButton, &H6, 1, 0&)  'ボタンをアクティブにする
+    Call SendMessage(hButton, &HF5, 0, 0&) 'ボタンをクリックする
+End Sub
+```