実行時エラーが表示されます。

質問

VBA初心者です。
下記コードのエラー修正をお願いします。
実行時エラー91
オブジェクト変数またはWithブロック変数が設定されていません
と出てしまいます。
デバッグではIf obj.Document の文がおかしいそうです。
またこのコードは不安定で、最後まで実行できる時もあれば、途中でエラーになるときもあるので修正頂けると嬉しいです。
よろしくお願いします。

Sub テスト()

Dim obj As Object

Set obj = CreateObject("InternetExplorer.Application.1")
obj.Visible = True
targetURL = "http://map.japanpost.jp/pc/syousai.php?id=300197019000"

obj.navigate (targetURL)
Do While obj.Busy
Loop

obj.Visible = True

For I = 0 To obj.Document.All.tags("div").Length - 1
If obj.Document.All.tags("div")(I).classname = "str_title_hira"
Then
S = obj.Document.All.tags("div")(I).InnerText
Worksheets("Sheet1").Range("A1") = S
End If
Next
For I = 0 To obj.Document.All.tags("div").Length - 1
If obj.Document.All.tags("div")(I).classname = "str_title_kana" Then
S = obj.Document.All.tags("div")(I).InnerText
Worksheets("Sheet1").Range("B1") = S
End If
Next
For I = 0 To obj.Document.All.tags("p").Length - 1
If obj.Document.All.tags("p")(I).classname = "unit" Then
S = obj.Document.All.tags("p")(I).InnerText
Worksheets("Sheet1").Range("C1") = S
End If
Next

obj.Quit

End Sub

Sub waitNavigation(ie As Object)
Do While ie.Busy Or ie.ReadyState < 4
DoEvents
Loop
End Sub

回答No.1

eden3616 · ベストアンサー

最下のVBAコードでは
「VBAのIE制御入門」http://www.vba-ie.net/
よりIE制御に関するサブルーチンプログラムを引用しています。

IEの読み込み待機を行うことで安定して動作するかと思います。
また駐車場の台数は不要ですか？改行コードによりセル出力時に行がずれてしまっていたため、下記のコードでは住所部分のみ取得しています。
testプロシージャにより、テストプロシージャを10回連続動作するようにしているため
最大行+1のA~C列へ書出すように出力部のコードを書き換えています。
あまり多くてもサーバーに不可をかけるだけなので動作確認程度に10回で行いましたが、問題なく動作しているようです。

■VBAコード
'▼VBAのIE制御入門のサブルーチン引用▼

#If VBA7 Then
　　　　Private Declare Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
#Else
　　　　Private Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)
#End If

'http://www.vba-ie.net/ie/navigate2.html#a3

Sub ieView(objIE As Object, _
　　　　　　　　urlName As String, _
　　　　　　　　Optional viewFlg As Boolean = True)
'IE(InternetExplorer)のオブジェクトを作成する
　　　　Set objIE = CreateObject("InternetExplorer.Application")
　　　　'IE(InternetExplorer)を表示・非表示
　　　　objIE.Visible = viewFlg
　　　　'指定したURLのページを表示する
　　　　objIE.Navigate urlName
　　　　'IEが完全表示されるまで待機
　　　　Call ieCheck(objIE)
End Sub

Sub ieCheck(objIE As Object)
Dim timeOut As Date
　　　　'完全にページが表示されるまで待機する
　　　　timeOut = Now + TimeSerial(0, 0, 20)
　　　　Do While objIE.Busy = True Or objIE.ReadyState <> 4
　　　　　　　　DoEvents
　　　　　　　　Sleep 1
　　　　　　　　If Now > timeOut Then
　　　　　　　　　　　　objIE.Refresh
　　　　　　　　　　　　timeOut = Now + TimeSerial(0, 0, 20)
　　　　　　　　End If
　　　　Loop
　　　　timeOut = Now + TimeSerial(0, 0, 20)
　　　　Do While objIE.document.ReadyState <> "complete"
　　　　　　　　DoEvents
　　　　　　　　Sleep 1
　　　　　　　　If Now > timeOut Then
　　　　　　　　　　　　objIE.Refresh
　　　　　　　　　　　　timeOut = Now + TimeSerial(0, 0, 20)
　　　　　　　　End If
　　　　Loop
End Sub
'▲ここまで▲

Sub test()
　　Dim i As Integer
　　　　For i = 1 To 10
　　　　　　　　Call テスト
　　　　Next i
End Sub

Sub テスト()
Dim obj As Object
　　　　Call ieView(obj, "http://map.japanpost.jp/pc/syousai.php?id=300197019000")
　　　　Do While obj.Busy
　　　　Loop
　　　　obj.Visible = True
　　　　For i = 0 To obj.document.All.tags("div").Length - 1
　　　　　　　　If obj.document.All.tags("div")(i).classname = "str_title_hira" Then
　　　　　　　　　　　　s = obj.document.All.tags("div")(i).InnerText
　　　　　　　　　　　　Worksheets("Sheet1").Cells(Cells(Rows.Count, "A").End(xlUp).Row + 1, "A") = s
　　　　　　　　End If
　　　　Next
　　　　For i = 0 To obj.document.All.tags("div").Length - 1
　　　　　　　　If obj.document.All.tags("div")(i).classname = "str_title_kana" Then
　　　　　　　　　　　　s = obj.document.All.tags("div")(i).InnerText
　　　　　　　　　　　　Worksheets("Sheet1").Cells(Cells(Rows.Count, "B").End(xlUp).Row + 1, "B") = s
　　　　　　　　End If
　　　　Next
　　　　For i = 0 To 1
　　　　　　　　If obj.document.All.tags("p")(i).classname = "unit" Then
　　　　　　　　　　　　s = obj.document.All.tags("p")(i).InnerText
　　　　　　　　　　　　Worksheets("Sheet1").Cells(Cells(Rows.Count, "C").End(xlUp).Row + 1, "C") = Replace(s, vbCrLf, " ")
　　　　　　　　End If
　　　　Next
　　　　obj.Quit
End Sub