Excel VBA 手動だと問題ないが通しだとエラーは出ないが処理されない

Excel VBA について
'ここにブレークポイントを指定して実行し、ブレークポイントで再度、実行をすると思い通りの結果になります。
F8キーを押して一行ずつ実行しても思い通りの結果になります。
ブレークポイントも何もなく通しで実行するとエラーは出ませんがシートはまっさらです。
F8キーを長押しで実行でもエラーは出ませんがシートはまっさらです。
しっかりと結果を反映するにはどうすればよいでしょうか？
お願いいたします。

Sub テスト()
Dim a As String
Dim b As Long
Dim d As Long
Dim g As Variant

Sheets("B").Select
Columns("A:B").Delete
a = 0
b = 1
d = 1

For d = 1 To 44
If d = 1 Then
a = "%E3%81%82" 'あ
ElseIf d = 2 Then
a = "%E3%81%84" 'い
ElseIf d = 3 Then
a = "%E3%81%86" 'う
ElseIf d = 4 Then
a = "%E3%81%88" 'え
ElseIf d = 5 Then
a = "%E3%81%8A" 'お
End If

Dim objHtml As Object
Dim objDoc As Object

Set objHtml = CreateObject("MSXML2.XMLHTTP")

objHtml.Open "GET", "https://www.jreast-timetable.jp/cgi-bin/st_search.cgi?rosen=&token=&50on=" & a, False
objHtml.send

Do While objHtml.readyState <> 4
    DoEvents
Loop

Set objDoc = New HTMLDocument
objDoc.write objHtml.responseText

For Each g In objDoc.getElementsByClassName("eki")　'ここ
Cells(b, 1) = g.innerText
b = b + 1
Next g

Set htmlDoc = Nothing

Next d
End Sub

行動規範の内容に同意します

回答3件

自己解決

VB
1Do While objDoc.getElementsByClassName("eki").Length = 0
2DoEvents
3Loop

'ここ　の上に上記の部分を追加し、

VB
1Sub テスト()
2Dim a As String
3Dim b As Long
4Dim d As Long
5Dim g As Variant
6
7Sheets("B").Select
8Columns("A:B").Delete
9a = 0
10b = 1
11d = 1
12
13For d = 1 To 44
14If d = 1 Then
15a = "%E3%81%82" 'あ
16ElseIf d = 2 Then
17a = "%E3%81%84" 'い
18ElseIf d = 3 Then
19a = "%E3%81%86" 'う
20ElseIf d = 4 Then
21a = "%E3%81%88" 'え
22ElseIf d = 5 Then
23a = "%E3%81%8A" 'お
24End If
25
26Dim objHtml As Object
27Dim objDoc As Object
28
29Set objHtml = CreateObject("MSXML2.XMLHTTP")
30
31objHtml.Open "GET", "https://www.jreast-timetable.jp/cgi-bin/st_search.cgi?rosen=&token=&50on=" & a, False
32objHtml.send
33
34Do While objHtml.readyState <> 4
35DoEvents
36Loop
37
38Set objDoc = New HTMLDocument
39objDoc.write objHtml.responseText
40
41Do While objDoc.getElementsByClassName("eki").Length = 0 '追加
42DoEvents '追加
43Loop '追加
44
45For Each g In objDoc.getElementsByClassName("eki")　'ここ
46Cells(b, 1) = g.innerText
47b = b + 1
48Next g
49
50Set htmlDoc = Nothing
51
52Next d
53End Sub

とすることで解決しました。

投稿2021/08/14 02:34

nullA

総合スコア0

当方、提示のコードを手持ちのexcel2013で実行させてみました。

まず、そのままだと以下の行で構文エラーとなるので

vb
1Set objDoc = New HTMLDocument

「Microsoft HTML Object Library」を参照設定し、

コンパイルしたところ

以下の行でエラーとなりました。

vb
1Set htmlDoc = Nothing

その後その行をコメント化して実行したところ、
F8キーを押して一行ずつ実行しても
ブレイクさせずに一気に実行しても

vb
1For Each g In objDoc.getElementsByClassName("eki")  'ここ

にて以下のエラーとなります。

当方の結論としては

F8キーを押して一行ずつ実行しても思い通りの結果になります。

という現象が謎事象ということになります。

投稿2021/08/13 12:39

takanaweb5

総合スコア358

その時、objHtml.responseText の中身はどうなっていますか？

勘ですが、objHtml.responseText <> "" になるまでLOOPで待機させるとか？

投稿2021/08/10 13:37

takanaweb5

総合スコア358

nullA

2021/08/10 15:04

objHtml.responseTextの中身は <!DOCTYPE html> <html lang="ja"> <head> <meta charset="UTF-8"> <meta http-equiv="X-UA-Compatible" content="IE=edge"> <meta name="description" content="JR東日本の駅の時刻表についてご案内しています。"> <meta name="keywords" content="ダイヤ,時刻,運転日,電車"> 以下省略のような感じになってます。 objHtml.responseText <> "" というのは Do While objHtml.responseText <> "" DoEvents Loop ということでしょうか？やってみたのですが、無限ループになりループを抜けられない状態でした。

takanaweb5

2021/08/10 22:35

等号と不等号が逆です。それでは""になるまでではなく <>""の間はloopするになってしまいます

nullA

2021/08/11 00:49

Do While objHtml.responseText >< "" DoEvents Loop とういうことでしょうか？自動で<>に変わってしまいます。等号の使い方がわからずうまくできないです。

takanaweb5

2021/08/11 02:01

等号は= 意味は一致するとき不等号は<> 意味は一致しないときです。

nullA

2021/08/12 11:58

ありがとうございます！ Do While objHtml.responseText = "" DoEvents Loop でやってみました。エラーは出なかったのですが変わらずセルには何も入力されずでした。

takanaweb5

2021/08/12 13:14

Debug.Print g.innerText を実行すれば、中身はどうなっていますか？中身が空なら、先と同じように Do While g.innerText = "" 　　DoEvents Loop で中身が取得できるまでLOOPさせてみればどうでしょうか？もし中身が空でなければ Cells(b, 1) = g.innerText　を Cells(b, 1) = "テスト" としてセルに「テスト」が設定されるか確認してみてください。

nullA

2021/08/12 13:32

Debug.Print g.innerText はFor Eachの中で合ってますか？ For Eachの外だとオブジェクトが必要ですのエラーになってしまうので中だと思うんですけど、中に追加した状態で実行するとFor Eachまで来た後はSet htmlDoc = Nothingに飛んでしまいます。 F8キーで手動で実行すると問題なく動きます。

行動規範の内容に同意します

あなたの回答