Excel VBA質問箱 IV

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

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


721 / 76735 ←次へ | 前へ→

【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
1 hits

【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 お礼[未読]

721 / 76735 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free