EXCELのwebクエリが反映されない。

EXCELのwebクエリ機能を使ってリアルタイムの為替情報を表に反映させたく、以下のページをみながらやってみました。
参照：http://www.hello-pc.net/howto-excel/exc_rate/
ですが、表が反映されません。（https://gyazo.com/fab14a26e303fdde0f25fd74ae332055）
その際に図のようなエラー表示がされました。

どうすれば反映されるようになりますでしょうか？
ご助言いただければ幸いです。

No.3 ベストアンサー 回答者： WindFaller 回答日時： 2016/05/25 21:22

スクリプトエラーは、以前は、IEのオプションで修正できたのですが、今は、それをやっても無理のようです。

もうここの書き込みは、顧みられることもないかもしれませんが、#2で書いたものが中途半端ですから、完成形を作っておきます。

http://nikkei225jp.com/fx/
(VBAコード内で文字化けする可能性がありますので、再度、登録しなおしてください　strURL = http://nikkei225jp.com/fx/　　"URL"をコーテーションマークで囲んでください。）

取得先は、『日経の為替チャート』(他も試みましたが、失敗しました。）
このマクロは、サーバーに負担を掛けるようなものではありませんが、ループして使うのは問題が残ると思います。なるべく、PC自体にも負担を掛けないためには、参照設定をしたほうがよいと思います。(その意味が分かる方のみに限ります）

なお、サイトが更新されれば、取得できなくなる可能性がありますから、このコードは、2016/5/25のタイム・スタンプということにしておきます。

'//
Sub OnTimeGetExRates()
　　Dim objIE As Object ''As InternetExplorer　'Microsoft Internet Control:参照設定
　　Dim ChgRates As Variant
　　Dim Countries As Variant
　　Dim strURL As String
　　Dim i As Long, j As Long, k As Long
　　Dim buf As Variant
　　Dim arBuf(5) As Variant
　　Dim Kinds As Variant
　　Dim StCell As Range
　　'20160525　
　　'最初の書き出しセルの場所
　　Set StCell = Range("A2")
　　
　　Set objIE = CreateObject("InternetExplorer.Application")
　　'Set objIE = New InternetExplorer '事前バインディングの場合
　　On Error GoTo ErrHandler
　　''**************
　　''取得先　at May 25,2016/ no guarantee after the future.
　　strURL = "http://nikkei225jp.com/fx/"
　　''*************
　　Countries = Array("ドル円", "ユーロ円", "ポンド円", "スイスフラン円", _
　　　　　　　　　　　　　　　　 "豪ドル円", "ニュージーランド円", "ユーロドル", "ドルインデックス")
　　ChgRates = Array("511", "514", "515", "513", "516", "517", "523", "501") '"V518" 不明
　　Kinds = Array("V", "H", "L", "C", "Z", "T")
　　
　　objIE.Navigate2 strURL
　　j = 1
　　Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
　　With objIE.document
　　　　　　　　For i = 1 To UBound(ChgRates) + 1
　　　　　　　　 On Error Resume Next
　　　　　　　　 buf = ""
　　　　　　　　 buf = .getElementByID("V" & ChgRates(i - 1)).InnerText
　　　　　　　　 For k = 0 To 5
　　　　　　　　　　arBuf(k) = .getElementByID(Kinds(k) & ChgRates(i - 1)).InnerText
　　　　　　　　 Next k
　　　　　　　　 If StCell.Cells(i, 1).Value = "" Then
　　　　　　　　　　　　 StCell.Cells(i, 1).Value = Countries(i - 1)
　　　　　　　　 End If
　　　　　　　　 For k = 0 To 5
　　　　　　　　　　 StCell.Cells(i, k + 2).Value = arBuf(k)
　　　　　　　　 Next k
　　　　　　　　 On Error Resume Next
　　　　　　　　Next i
　　　　End With
ErrHandler:
If Err.Number <> 0 Then
　　　　 MsgBox Err.Number & " :" & Err.Description
End If
objIE.Quit
Set objIE = Nothing
Beep
End Sub

'//

この回答へのお礼

ありがとうございます。
すみません、マクロやVBAについての知識が全く無く、それらを調べておりベストアンサーを選択するのを忘れてしまっておりました。。大変申し訳ありませんでした。。
ご相談なのですが、もし可能であれば、これらを反映したエクセルデータをお送りいただくことはできないでしょうか・・。firestorage等にアップいただけると大変助かります。。
あつかましいお願いをしてしまい申し訳ありません。何卒ご検討の程、よろしくお願いいたします。

お礼日時：2016/05/25 21:44

No.2 回答者： WindFaller 回答日時： 2016/05/20 17:39

私が見た限りでは、サイトが常に更新を続けているので、Webクエリでは、取れないような仕組みになっていると思うです。

IE を立ち上げて、その日経の為替のページの為替欄を右クリックしてみると、「要素の検査（分析）」の、マウスメニュー（コンテクスト）が出てきません。

おまけに、今、私がしばらく開発のために開けていたら、自動更新が停止されてしまいました。それで、Refreshコマンドをかけたら、IEがハングしてしまいました。

それで、いろいろ考えた挙句、マクロのIEオブジェクトで取得する方法しか思いつきませんでした。他の為替のページで試したらいかがでしょうか。ただ、こちらのマクロは、繰り返しを頻繁にすれば別かもしれまんせが、決して、サーバーの負担など掛けはしていないはずです。

これは、為替の大きな文字の部分（中心レート？）だけです。


'//　標準モジュール

Sub OnTimeGetExRates()
　Dim objIE As Object ''InternetExplorer　　 'Microsoft Internet Control
　Dim ChgRates As Variant
　Dim Countries As Variant
　Dim strURL As String
　Dim i As Long
　Dim buf As Variant
'Set objIE = New InternetExplorer
　Set objIE = CreateObject("InternetExplorer.Application")
　On Error GoTo ErrHandler
　strURL = "http://nikkei225jp.com/fx/"
　Countries = Array("ドル円", "ユーロ円", "ポンド円", "スイスフラン円", _
　　　　　　　　 "豪ドル円", "ニュージーランド円", "ユーロドル", "ドルインデックス")
　ChgRates = Array("V511", "V514", "V515", "V513", "V516", "V517", "V523", "V501") '"V518" 不明
　objIE.Navigate2 strURL
　Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
　With objIE.document
　　　　For i = 1 To UBound(ChgRates) + 1
　　　　 On Error Resume Next
　　　　 buf = ""
　　　　 buf = .getElementById(ChgRates(i - 1)).innerText
　　　　 If Cells(i, 1).Value = "" Then
　　　　　　 Cells(i, 1).Value = Countries(i - 1)
　　　　 End If
　　　　 Cells(i, 2).Value = buf
　　　　 On Error Resume Next
　　　　Next i
　　End With
ErrHandler:
''objIE.Refresh ''これは、一応禁止にしておきます。
If Err.Number <> 0 Then
　　 MsgBox Err.Number & " :" & Err.Description
End If
objIE.Quit
Set objIE = Nothing
Beep
End Sub
'//
取得後の画面

No.1 回答者： CoalTar 回答日時： 2016/05/20 17:28

提示されたリンク先で「Webクエリで取り込めないもの」の中に

「スクリプトエラー」が出るWebサイト
とあるので取り込めないのでは？