|
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
|
|