ExcelVBAでXML取得をしたいがHTTPアクセスができない　理由は？

いつもお世話になっております。
ExcelVBAでXML取得するプログラムを考えています。
サイトはこちらを参考にしました。
https://qiita.com/isamusuzuki/items/b2e88184e7cfb75877a8

【困っていること】

しかし、動かす時に問題がでてきます。
それが「HTTPアクセスができない」ということです。
主に、上記、参考にしたサイトのコードの中にある下記の部分で「サーバーへの接続に失敗しました」となってしまいます。


'HTTPアクセスに失敗があったら中止
If http.statusText <> "OK" Then
    MsgBox "サーバーへの接続に失敗しました", vbCritical
    Exit Sub
End If

【聞きたいこと】

そこで、上記URLのコードでHTTPアクセスができるようにするためにはどうしたらいいのかを知りたいのですがどなたかご存知のかたはいらっしゃいますでしょうか？

なお、参照設定で「Microsoft XML, v6.0」チェックを入れております。

また、上記URLのコードでうまくいかなかったため、個人的にXMLを取得するプログラムを作ってみました。
それが下記コードです。

しかし、この下記コードでもやはりHTMLを除いたnewstitleとLocの情報を取得することができていません。
やはり、上記の通り、HTTPアクセスができないと難しい・・ということなのかなと思っています。

よろしくお願いいたします。

VBAOption
1
2Sub test()
3    Dim wbActive As Workbook 'アクティブワークブック
4    Dim strURL As String 'URL
5    Dim httpReq As XMLHTTP60
6    Set httpReq = New XMLHTTP60
7    
8    'アクティブワークブックをゲット
9    Set wbActive = ThisWorkbook
10    wbActive.Worksheets("Sheet1").Activate
11    strURL = wbActive.Worksheets("Sheet1").TextBox1.Text
12    
13    httpReq.Open "GET", strURL
14    httpReq.send
15     
16    Do While httpReq.readyState < 4
17        DoEvents
18    Loop
19    
20    Debug.Print httpReq.responseText
21    '黄色のセルにXMLを表示
22    'ここで本当はHTMLを除いたnewstitleとLocの情報を取得して、EXCELの列に一覧として並べたい
23    wbActive.Worksheets("Sheet1").Range("B10").Value = httpReq.responseText
24    
25    Set httpReq = Nothing
26
27    MsgBox "処理が終了しました"
28    
29End Sub
30
31

【追記】

他の方からアドバイスをいただきました。
それに従って、
https://qiita.com/isamusuzuki/items/b2e88184e7cfb75877a8
こちらのコードの一部分を以下のように変更して動かしてみました。

Private Sub GetXML()
    Dim wbActive As Workbook 'アクティブワークブック
    Dim strURL As String 'URL
    
    Dim doc As DOMDocument60
    Dim node As IXMLDOMNode
    Dim url As String
    Dim i As Integer
    'アクティブワークブックをゲット
    Set wbActive = ThisWorkbook
    wbActive.Worksheets("Sheet1").Activate
    strURL = wbActive.Worksheets("Sheet1").TextBox1.Text
       
    'HTTPアクセスを設定して発射
    Dim http As XMLHTTP60
    Set http = New XMLHTTP60
    
'    http.Open "GET", strURL, False
'    http.send
    http.Open "GET", strURL
    http.send

    'HTTPアクセスに失敗があったら中止
'    If http.statusText <> "OK" Then
'        MsgBox "サーバーへの接続に失敗しました", vbCritical
'        Exit Sub
'    End If
    If http.Status <> 200 Then
        MsgBox "サーバーへの接続に失敗しました", vbCritical
        Exit Sub
    End If
    'XMLデータを取り込む
    Set doc = New DOMDocument60
    doc.LoadXML (http.responseText)
    
    'XPathを使ってノード（要素）を取り込む
    i = 1
    For Each node In doc.SelectNodes("//rc")
        '各ノードのtitle属性を取得して、シートに貼り付ける
        ActiveSheet.Range("A" & i + 2).Value = i & ": " & node.Attributes.getNamedItem("title").Text
        i = i + 1
    Next
    
    '後片付け
    Set http = Nothing
    Set doc = Nothing
    Set node = Nothing

End Sub

しかし、次はこの部分でFor each内の処理に入らず、後片付けの処理に飛んでしまいます。

'XPathを使ってノード（要素）を取り込む
    i = 1
    For Each node In doc.SelectNodes("//rc")

これは、結局は「http.Status」の部分が空だからそうなってしまうのでしょうか？
どうしたらFor Each内の処理に入ってくれるのか分かりません。

どなたかご存知の方がいたら教えていただきたいと思っております。

よろしくお願いいたします。

otn

2020/03/03 14:29

http.statusText の値は？

退会済みユーザー

2020/03/03 15:09

すみません、間違いがあったので全体的に変更いたしました。なお、htttp.status.textに入るURLは https://www.asahi.com/sitemap/sitemap_business.xml を想定しています。何か分かればありがたいです、よろしくお願いいたします。

otn

2020/03/03 16:08 編集

http.statusText （あるいは、http.status）の値は？

otn

2020/03/03 16:46

↑を丁寧に書くと、 http.statusText （あるいは、http.status）の値を表示するコードを追加して、その表示内容を追記

退会済みユーザー

2020/03/04 00:13

ありがとうございます。そういうことでしたね、勘違いしていました。 http.statusText の値は””　つまり空になります。

otn

2020/03/04 08:02 編集

では、表示させるのは http.status の値ですね。

行動規範の内容に同意します

回答1件

ベストアンサー

サーバ側でstatusTextを設定していない可能性があります。
サーバによってはstatusコードのみでstatusTextは返しません。

【参考】
(Syncer) XMLHttpRequest.statusText - ステータスのメッセージ
https://lab.syncer.jp/Web/API_Interface/Reference/IDL/XMLHttpRequest/statusText/

そのような場合は、http.status = 200 で判断してください。

投稿2020/03/04 02:18

h.horikoshi

総合スコア505

退会済みユーザー

2020/03/04 03:10

ありがとうございます！そういうことだったのですね・・・ちなみに、https://qiita.com/isamusuzuki/items/b2e88184e7cfb75877a8 このサイトの中にあるコードをコピーして、http.status = 200 で判断してみましたが、次の処理 i = 1 For Each node In doc.SelectNodes("//rc") '各ノードのtitle属性を取得して、シートに貼り付ける ActiveSheet.Range("A" & i + 2).Value = i & ": " & node.Attributes.getNamedItem("title").Text i = i + 1 Next の時に＞ For Each node In doc.SelectNodes("//rc") この部分でもう条件分岐の判断処理をせずメモリ解放に飛んで処理が終了してしまいました。これは結局はstatusの中身が空だったということになるのでしょうか？

Y.H.

2020/03/04 04:12

> SelectNodes("//rc") rcなんてNodeがhttps://www.asahi.com/sitemap/sitemap_business.xmlに無いからです。参照したコードのコピペ元は取得しているxmlが違いますよね？同じURL(https://ja.wikipedia.org/w/api.php?action=query&list=recentchanges&rcnamespace=0&format=xml)ならrcというNodeがあるので取得できます。

退会済みユーザー

2020/03/04 04:39

ああ！そういうことでしたか。なるほど。先ほど、URLは https://ja.wikipedia.org/w/api.php?action=query&list=recentchanges&rcnamespace=0&format=xml にして、 SelectNodes("//rc") にしてみました。そしたら、無事思い通りにいきました。その後、URLを https://www.asahi.com/sitemap/sitemap_business.xml にして、 SelectNodes("//news") にしてみましたが、For Eachに入ってくれませんでした。また、試しに「loc」も入れてみましたが、それでもFor Eachに入ってくれませんでした。なぜWikiだとうまくいって、asahi.comだとうまくいかないのでしょうか？

Y.H.

2020/03/04 05:00

本質問の主題は > 上記URLのコードでHTTPアクセスができるようにするためにはどうしたらいいのかを知りたいだと思うのですが。 xpathの指定の仕方など以下参照いただきわからないところは具体的に別で質問されたほうが良いかと思います。 https://www.google.com/search?q=xpath

h.horikoshi

2020/03/09 06:56

※質問タイトルと異なりますので蛇足になりますが、XMLの要素取り出しについて Excelは、XMLに対応していますし、その際の読み込みファイルには URLの指定もできます。このため例えば Workbooks.Open("https://www.asahi.com/sitemap/sitemap_business.xml") と書けば、シート上にXMLが展開され、XML要素はそこから拾えますので、簡単な用途であればDOM解析は不要です。

行動規範の内容に同意します