teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

2

IE表示待ちのコード追加

2018/12/05 13:30

投稿

TanakaHiroaki
TanakaHiroaki

スコア1065

answer CHANGED
@@ -34,4 +34,85 @@
34
34
  ```
35
35
 
36
36
  また、Sleep関数は 64bitでもLongで渡します。
37
- Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
37
+ Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)
38
+
39
+ <追記>
40
+ 私が普段使っているIE表示待ちも試してみてください。
41
+ これでダメならお役に立てそうにありません。
42
+ ```VBA
43
+ Public Sub Myloop(ByRef ie As Object)
44
+
45
+ Dim nowURL As String
46
+ nowURL = ie.LocationURL
47
+
48
+ Dim IEretry As Boolean: IEretry = False
49
+ Dim RepeatSec As Single: RepeatSec = Timer
50
+
51
+ On Error GoTo INVALID
52
+
53
+ Do While ie.Busy = True Or ie.readyState < 4 'READYSTATE_COMPLETE
54
+ DoEvents: Sleep 200 '200ms停止
55
+
56
+ If (Timer - RepeatSec) > 80 Then
57
+ Debug.Print ie.readyState
58
+ MsgBox "サーバーが応答していません。インターネット接続をご確認後、再度実行してください。"
59
+ ie.Quit
60
+ End
61
+ ElseIf (Timer - RepeatSec) > 40 And IEretry = False Then
62
+ 'IEの再読み込みは1回限りとする
63
+ IEretry = True
64
+ On Error Resume Next
65
+ ie.Refresh
66
+ Debug.Print "ie.Refresh/エラー番号:" & Err.Number & vbNewLine & "エラーの種類:" & Err.Description
67
+ On Error GoTo INVALID
68
+ End If
69
+ Loop
70
+
71
+ DoEvents
72
+
73
+ Do While ie.document.readyState <> "complete"
74
+ DoEvents: Sleep 200 '200ms停止
75
+
76
+ If (Timer - RepeatSec) > 100 Then
77
+ Debug.Print ie.document.readyState
78
+ ie.Quit
79
+ MsgBox "ドキュメントを取得できません。インターネット接続をご確認後、再度実行してください。"
80
+ End
81
+ End If
82
+ Loop
83
+
84
+ '念のため確認
85
+ DoEvents: Sleep 1: DoEvents
86
+ If ie.Busy = True Or ie.readyState < 4 Then
87
+ Call Myloop(ie) '再帰呼出
88
+ End If
89
+
90
+ Exit Sub
91
+
92
+ INVALID:
93
+
94
+ Debug.Print "エラー番号:" & Err.Number & vbNewLine & "エラーの種類:" & Err.Description
95
+
96
+ If Err.Number = 70 Then
97
+ '実行時エラー「書き込みできません。」(70)は想定内なので無視。
98
+ On Error GoTo 0
99
+ MsgBox "IE読み込み時にエラー発生。処理を継続します。"
100
+
101
+ ElseIf Err.Number = -2147417848 Then
102
+ On Error GoTo 0
103
+ '新規IEオブジェクト作成
104
+ Dim getIE As Object
105
+ Set getIE = CreateObject("InternetExplorer.Application")
106
+ getIE.Visible = True
107
+ getIE.navigate nowURL 'URL指定
108
+
109
+ MsgBox "対象IEが存在しないため、IEを起動します。"
110
+ Set ie = getIE
111
+ getIE = Nothing
112
+
113
+ Else
114
+ '上記以外はエラーを発生させる。
115
+ Err.Raise Err.Number
116
+ End If
117
+ End Sub
118
+ ```

1

Sleep関数について補足

2018/12/05 13:30

投稿

TanakaHiroaki
TanakaHiroaki

スコア1065

answer CHANGED
@@ -1,5 +1,4 @@
1
1
  IE表示待ちでしつこくステータスを確認してはどうでしょうか。
2
-
3
2
  ```VBA
4
3
  Function ie_wait(objIE As Object) As Boolean
5
4
  Dim timeout As Date
@@ -32,4 +31,7 @@
32
31
 
33
32
  ie_wait = True
34
33
  End Function
35
- ```
34
+ ```
35
+
36
+ また、Sleep関数は 64bitでもLongで渡します。
37
+ Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As Long)