teratail
回答率
85.35%
teratail header banner
teratail header banner
質問するログイン新規登録
トップに関する質問VBA　上の処理が完了するまで処理を止める方法について

編集履歴

質問編集履歴

2

コードの修正

2020/06/09 09:00

投稿

hirokin92
hirokin92

スコア3

test CHANGED
File without changes
test CHANGED
@@ -234,7 +234,7 @@
234
234
 
235
235
  For Each access In WebIE.document.getElementsByTagName("a") '①FOR EACH でINPUTをすべて抜き出す。
236
236
 
237
- If access.innerText = "アクセス" Or access.innerText = "会社概要" Or access.innerText = "会社概要・アクセス" Then
237
+ If access.innerText = "テスト" Or access.innerText = "テスト1" Or access.innerText = "テスト2" Then
238
238
 
239
239
  While WebIE.Busy Or WebIE.readyState <> READYSTATE_COMPLETE
240
240
 

1

コードを全体に修正しました。

2020/06/09 09:00

投稿

hirokin92
hirokin92

スコア3

test CHANGED
File without changes
test CHANGED
@@ -32,28 +32,252 @@
32
32
 
33
33
  ■作成したコード
34
34
 
35
- 1.Dim juusyo As Object
36
-
37
- 2.Dim cntn As Long
38
-
39
- 3.cntn = 5
40
-
41
- 4.For Each juusyo In webIE.document.getElementsByTagName("p")
42
-
43
- 5.If InStr(juusyo.innerText, "東京都") > 0 Then
44
-
45
- 6.MsgBox juusyo.innerText
46
-
47
- 7.Cells(cntn, 1).Value = juusyo.innerText
48
-
49
- 8.End If
50
-
51
- 9.Next
52
-
53
-
54
-
55
-
56
-
57
- 「4.」の処理が完了するまで5以降の処理は止めたいです。
58
-
59
- よろしくお願いいたします。
35
+ Sub test()
36
+
37
+
38
+
39
+ Dim searchx As String
40
+
41
+ Dim searchy As String
42
+
43
+ Dim all As String
44
+
45
+ Dim box() As String
46
+
47
+
48
+
49
+ Dim WebIE As InternetExplorer
50
+
51
+
52
+
53
+ '------------------------------------
54
+
55
+ '★セルの文字取得
56
+
57
+
58
+
59
+ searchx = Cells(1, 1)
60
+
61
+ searchy = Mid(Cells(1, 5), InStr(Cells(1, 5), "@") + 1, 20)
62
+
63
+ all = searchx + " " + searchy
64
+
65
+ '------------------------------------
66
+
67
+
68
+
69
+ '------------------------------------
70
+
71
+ '★変数webIEを使用してIE起動
72
+
73
+
74
+
75
+ Set WebIE = New InternetExplorer
76
+
77
+
78
+
79
+ WebIE.Visible = True
80
+
81
+ WebIE.Navigate "https://www.google.com/?hl=ja"
82
+
83
+ '------------------------------------
84
+
85
+
86
+
87
+ '------------------------------------
88
+
89
+ '★IEのリロード完了まで処理をしない
90
+
91
+
92
+
93
+ While WebIE.Busy Or WebIE.readyState <> READYSTATE_COMPLETE
94
+
95
+ DoEvents
96
+
97
+ Wend
98
+
99
+ '------------------------------------
100
+
101
+
102
+
103
+ On Error Resume Next '値がないとエラーが出るので、エラー回避用
104
+
105
+
106
+
107
+ '------------------------------------
108
+
109
+ '★値をWebで入力
110
+
111
+ Dim A As Object
112
+
113
+ For Each A In WebIE.document.getElementsByTagName("INPUT") '①FOR EACH でINPUTをすべて抜き出す。
114
+
115
+ If A.name = "q" Then A.Value = all
116
+
117
+ Next
118
+
119
+ '------------------------------------
120
+
121
+
122
+
123
+
124
+
125
+ '------------------------------------
126
+
127
+ '★検索ボタンをクリック
128
+
129
+ Dim b As Object
130
+
131
+ For Each b In WebIE.document.getElementsByTagName("INPUT") '①FOR EACH でINPUTをすべて抜き出す。
132
+
133
+ If A.name = "btnk" Then b.Click
134
+
135
+ While WebIE.Busy Or WebIE.readyState <> READYSTATE_COMPLETE
136
+
137
+ DoEvents
138
+
139
+ Wend
140
+
141
+ Next
142
+
143
+ '------------------------------------
144
+
145
+
146
+
147
+ '-------------------------------------
148
+
149
+ '★指定したURLのみ取得
150
+
151
+ Dim i As Long
152
+
153
+ Dim boxi As Long
154
+
155
+ ReDim box(boxi)
156
+
157
+ i = 5
158
+
159
+ boxi = 0
160
+
161
+
162
+
163
+ Dim htmlDoc As HTMLDocument
164
+
165
+ Set htmlDoc = WebIE.document
166
+
167
+ Dim anchor As HTMLAnchorElement
168
+
169
+
170
+
171
+ For Each anchor In htmlDoc.Links
172
+
173
+
174
+
175
+ If InStr(anchor, searchy) <> 0 And InStr(anchor, "google.com") = 0 Then
176
+
177
+ box(boxi) = anchor
178
+
179
+ 'Cells(i, 1).Value = anchor
180
+
181
+ Else
182
+
183
+ boxi = boxi - 1
184
+
185
+ i = i - 1
186
+
187
+ End If
188
+
189
+
190
+
191
+
192
+
193
+ i = i + 1
194
+
195
+ boxi = boxi + 1
196
+
197
+ Next anchor
198
+
199
+
200
+
201
+ '-------------------------------------
202
+
203
+ WebIE.Quit
204
+
205
+
206
+
207
+ Set WebIE = New InternetExplorer
208
+
209
+ WebIE.Visible = True
210
+
211
+ WebIE.Navigate2 box(0)
212
+
213
+ '------------------------------------
214
+
215
+
216
+
217
+ '------------------------------------
218
+
219
+ '★IEのリロード完了まで処理をしない
220
+
221
+
222
+
223
+ While WebIE.Busy Or WebIE.readyState <> READYSTATE_COMPLETE
224
+
225
+ DoEvents
226
+
227
+ Wend
228
+
229
+
230
+
231
+ '------------------------------------
232
+
233
+ Dim access As Object
234
+
235
+ For Each access In WebIE.document.getElementsByTagName("a") '①FOR EACH でINPUTをすべて抜き出す。
236
+
237
+ If access.innerText = "アクセス" Or access.innerText = "会社概要" Or access.innerText = "会社概要・アクセス" Then
238
+
239
+ While WebIE.Busy Or WebIE.readyState <> READYSTATE_COMPLETE
240
+
241
+ DoEvents
242
+
243
+ Wend
244
+
245
+ access.Click
246
+
247
+ Exit For
248
+
249
+ End If
250
+
251
+ Next
252
+
253
+
254
+
255
+ Dim juusyo As Object
256
+
257
+ Dim cntn As Long
258
+
259
+ Dim change As String
260
+
261
+
262
+
263
+ cntn = 5
264
+
265
+ For Each juusyo In WebIE.document.getElementsByTagName("p")
266
+
267
+ If InStr(juusyo.innerText, "東京都") > 0 Then
268
+
269
+ Cells(cntn, 1).Value = juusyo.innerText
270
+
271
+ Else
272
+
273
+ End If
274
+
275
+
276
+
277
+ Next
278
+
279
+
280
+
281
+
282
+
283
+ End Sub