Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
173 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【81676】WEB取り込みの際にエラーが出たり出なかったり。 K.K 21/3/7(日) 11:43 質問[未読]
【81677】Re:WEB取り込みの際にエラーが出たり出なか... γ 21/3/9(火) 13:00 発言[未読]
【81678】Re:WEB取り込みの際にエラーが出たり出なか... K.K 21/3/9(火) 22:03 お礼[未読]
【81679】Re:WEB取り込みの際にエラーが出たり出なか... γ 21/3/9(火) 23:02 回答[未読]
【81680】Re:WEB取り込みの際にエラーが出たり出なか... ［名前なし］K.K 21/3/12(金) 0:10 お礼[未読]
【81676】WEB取り込みの際にエラーが出たり出なか...
質問  K.K  - 21/3/7(日) 11:43 -
引用なし
パスワード
   天気予報のWEBサイトをエクセルに書き出す目的で作りましたが、
「実行時エラー'91 オブジェクト変数またはWITHブロック変数が設定されていません。」
が出たり、出なかったりします。

以下その構文ですが、

Sub 天気予報取り込み()

Application.ScreenUpdating = False

　　Dim ie As InternetExplorer
　　Dim Doc As HTMLDocument
　　Dim ObjTag As Object
　　Dim i As Long
　　Dim n As Long
　　
　　Set ie = CreateObject("InternetExplorer.Application")
　　ie.Visible = False
　　ie.navigate "WEBサイトのURL"
　　Do While ie.Busy Or ie.readyState < READYSTATE_COMPLETE
　　　　DoEvents
　　Loop
　　
　　Worksheets("天気").Select
　　Cells.ClearContents
　　Cells.NumberFormatLocal = "G/標準"
　　
　　
　　Set Doc = ie.document
　　For i = 696 To 936
　　　　If Doc.all(i).tagName = "TD" Or Doc.all(i).tagName = "TH" Then
　　　　　 n = n + 1
　　　　　　Cells(Int((n - 1) / 8) + 1, (n - 1) Mod 8 + 1) = Doc.all(i).innerText
　　　　End If
　　　 Next i
　　　　
　　Cells.EntireColumn.AutoFit
　　Cells.EntireRow.AutoFit
ie.Quit

　ActiveWorkbook.Save
　Application.ScreenUpdating = True

　
End Sub

一度マクロ実行すると、
If Doc.all(i).tagName = "TD" Or Doc.all(i).tagName = "TH" Then
の所で最初に書いたエラー(デバッグ?)がかかります。

そのまま「終了」を押してもう一度実行すると今度はちゃんと動いたりします。

考えられる異常が何かあればご示唆お願いします。
Windows10　excel2007です。
以前にこのファイルでクエリを使おうとしましたが、その名残がどこかでエラーを引き起こしているのでしょうか?
【81677】Re:WEB取り込みの際にエラーが出たり出な...
発言  γ  - 21/3/9(火) 13:00 -
引用なし
パスワード
   どのサイトなのかという重要な手がかりを秘密にしているので、
回答はつきにくいでしょう。
無理にとは言いませんが、URLは示せないのですか？
（その提示が無いと、解決する見込みは著しく低下します。
　むろん確実に解決すると保証するわけにはいきませんが。）

別に言い訳は不要で放置すればよいだけなのですが、
こうした質疑に関する常識として持たれておくことも必要かと思い、
敢えてメモします。

WEBサイトは個々で作りが違いますから、
具体的なurlなしで想像できることには限りがあります。

実際に動作することもあるようですから、
コードの問題でも無いような気もしますが、
仮にコードに問題があるとしても、基本的なコードの間違いでもない限り、
実際に動作させて検証するのが確実ですし、手間もかかりません。
色々な条件をあれこれ想定して研究してくれる奇特な回答者は少ないでしょう。

こうした自動アクセスに抑制的なサイトもあります。
一定期間に何度もアクセスがあったときに、不審アクセスとして特定の
結果を返すサイトもあります。
エラーになったときに、サイトから何が返されているかを検証することが
解決の第一歩でしょう。

回答するにあたって、そういうことを試すにもurlは必要です。
【81678】Re:WEB取り込みの際にエラーが出たり出な...
お礼  K.K  - 21/3/9(火) 22:03 -
引用なし
パスワード
   そうなんですね。

//www.jma.go.jp/bosai/forecast/#area_type=class20s&area_code=2610000

で一度試してみていただけませんか。

URLはキッチリ書き込むとエラーかかるので、頭は省略しています。
【81679】Re:WEB取り込みの際にエラーが出たり出な...
回答  γ  - 21/3/9(火) 23:02 -
引用なし
パスワード
   IE側のDOM構成処理が追いついていないことが原因と思われる。
少々の待ち時間を入れている。

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '■■■追加

Sub 天気予報取り込み()

　　'Application.ScreenUpdating = False '更新状況を確認するためコメントアウト
　　Dim ie As InternetExplorer
　　Dim Doc As HTMLDocument
　　Dim ObjTag As Object
　　Dim i As Long
　　Dim n As Long
　　Dim url As String
　　
　　url = "//www.jma.go.jp/bosai/forecast/#area_type=class20s&area_code=2610000"'■要修正
　　Set ie = CreateObject("InternetExplorer.Application")
　　'ie.Visible = True
　　ie.Visible = False
　　ie.navigate url
　　Do While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
　　　　DoEvents
　　Loop

　　Worksheets("天気").Select
　　Cells.ClearContents
　　Cells.NumberFormatLocal = "G/標準"

　　Set Doc = ie.document
　　Sleep 2000　　　　　　　'■■■■追加(2秒待つ）
　　For i = 696 To 936
　　　　If Doc.all(i).tagName = "TD" Or Doc.all(i).tagName = "TH" Then
　　　　　　n = n + 1
　　　　　　Cells(Int((n - 1) / 8) + 1, (n - 1) Mod 8 + 1) = Doc.all(i).innerText
　　　　End If
　　Next i

　　Cells.EntireColumn.AutoFit
　　Cells.EntireRow.AutoFit
　　ie.Quit
　　ActiveWorkbook.Save
　　Application.ScreenUpdating = True
End Sub
【81680】Re:WEB取り込みの際にエラーが出たり出な...
お礼  ［名前なし］K.K  - 21/3/12(金) 0:10 -
引用なし
パスワード
   ありがとうございます。
安定してデーターを抜き出せるようになりました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
173 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free