編集履歴

回答編集履歴

追記３のコードスリム化

2021/07/13 09:29

投稿

スコア1063

test CHANGED Viewed

@@ -184,15 +184,9 @@
 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
@@ -200,7 +194,7 @@
             'タイヤログ操作成功時にVBScriptが制御不可。VBAは ie.Busy = True　が成立。
-            Exit Function
+            Exit Sub
         End If

誤記再修正

2021/07/13 09:29

投稿

TanakaHiroaki

スコア1063

test CHANGED Viewed

@@ -238,8 +238,6 @@
             If ie.readyState = 4 Then
-                OutputWarn "IE Busy In vbs.IEWaitReady"
                 Exit Do
             Else

誤記修正

2021/07/13 09:20

投稿

TanakaHiroaki

スコア1063

test CHANGED Viewed

@@ -104,7 +104,7 @@
 ```
-＜追記２＞
+＜追記３＞
 IE操作してダイアログ表示させる IEbotton.vbs のコードです。

VBScriptのコード追加

2021/07/13 09:17

投稿

TanakaHiroaki

スコア1063

test CHANGED Viewed

@@ -103,3 +103,191 @@
     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

スコア1063

test CHANGED Viewed

@@ -76,7 +76,7 @@
     Do
-        If ie.Busy = True Then '★VBScriptによるタイヤログ操作成功時にTrue
+        If ie.Busy = True Then '★VBScriptタイヤログ操作成功時Trueとなる
             Sleep 500
@@ -96,7 +96,7 @@
         End If
-        If Now > timeOut Then End '★VBScriptによるによるタイヤログ操作失敗
+        If Now > timeOut Then End '★VBScriptタイヤログ操作失敗と判断
         Sleep 100

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

2021/07/12 13:08

投稿

TanakaHiroaki

スコア1063

test CHANGED Viewed

@@ -84,9 +84,9 @@
             hProc = OpenProcess(PROCESS_ALL_ACCESS, 0, TaskId)
-            If hProc <> 0& Then   'プロセスハンドルが返されたかを判定
+            If hProc <> 0& Then         'プロセスハンドルが返されたかを判定
-                CloseHandle hProc 'プロセスクローズ
+                Call CloseHandle(hProc) 'プロセスクローズ
             End If

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

2021/07/12 13:05

投稿

TanakaHiroaki

スコア1063

test CHANGED Viewed

@@ -59,3 +59,47 @@
 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

スコア1063

test CHANGED Viewed

@@ -9,3 +9,53 @@
 参考QA
 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
+```