質問編集履歴

2

他の方からのアドバイスを受けて追記

2020/03/04 03:34

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -133,3 +133,151 @@
133
133
 
134
134
 
135
135
  ```
136
+
137
+
138
+
139
+ ### 【追記】
140
+
141
+ 他の方からアドバイスをいただきました。
142
+
143
+ それに従って、
144
+
145
+ [https://qiita.com/isamusuzuki/items/b2e88184e7cfb75877a8](https://qiita.com/isamusuzuki/items/b2e88184e7cfb75877a8)
146
+
147
+ こちらのコードの一部分を以下のように変更して動かしてみました。
148
+
149
+
150
+
151
+ ```ここに言語を入力
152
+
153
+ Private Sub GetXML()
154
+
155
+ Dim wbActive As Workbook 'アクティブワークブック
156
+
157
+ Dim strURL As String 'URL
158
+
159
+
160
+
161
+ Dim doc As DOMDocument60
162
+
163
+ Dim node As IXMLDOMNode
164
+
165
+ Dim url As String
166
+
167
+ Dim i As Integer
168
+
169
+ 'アクティブワークブックをゲット
170
+
171
+ Set wbActive = ThisWorkbook
172
+
173
+ wbActive.Worksheets("Sheet1").Activate
174
+
175
+ strURL = wbActive.Worksheets("Sheet1").TextBox1.Text
176
+
177
+
178
+
179
+ 'HTTPアクセスを設定して発射
180
+
181
+ Dim http As XMLHTTP60
182
+
183
+ Set http = New XMLHTTP60
184
+
185
+
186
+
187
+ ' http.Open "GET", strURL, False
188
+
189
+ ' http.send
190
+
191
+ http.Open "GET", strURL
192
+
193
+ http.send
194
+
195
+
196
+
197
+ 'HTTPアクセスに失敗があったら中止
198
+
199
+ ' If http.statusText <> "OK" Then
200
+
201
+ ' MsgBox "サーバーへの接続に失敗しました", vbCritical
202
+
203
+ ' Exit Sub
204
+
205
+ ' End If
206
+
207
+ If http.Status <> 200 Then
208
+
209
+ MsgBox "サーバーへの接続に失敗しました", vbCritical
210
+
211
+ Exit Sub
212
+
213
+ End If
214
+
215
+ 'XMLデータを取り込む
216
+
217
+ Set doc = New DOMDocument60
218
+
219
+ doc.LoadXML (http.responseText)
220
+
221
+
222
+
223
+ 'XPathを使ってノード(要素)を取り込む
224
+
225
+ i = 1
226
+
227
+ For Each node In doc.SelectNodes("//rc")
228
+
229
+ '各ノードのtitle属性を取得して、シートに貼り付ける
230
+
231
+ ActiveSheet.Range("A" & i + 2).Value = i & ": " & node.Attributes.getNamedItem("title").Text
232
+
233
+ i = i + 1
234
+
235
+ Next
236
+
237
+
238
+
239
+ '後片付け
240
+
241
+ Set http = Nothing
242
+
243
+ Set doc = Nothing
244
+
245
+ Set node = Nothing
246
+
247
+
248
+
249
+ End Sub
250
+
251
+ ```
252
+
253
+
254
+
255
+ しかし、次はこの部分でFor each内の処理に入らず、後片付けの処理に飛んでしまいます。
256
+
257
+
258
+
259
+ ```ここに言語を入力
260
+
261
+ 'XPathを使ってノード(要素)を取り込む
262
+
263
+ i = 1
264
+
265
+ For Each node In doc.SelectNodes("//rc")
266
+
267
+
268
+
269
+ ```
270
+
271
+
272
+
273
+ これは、結局は「http.Status」の部分が空だからそうなってしまうのでしょうか?
274
+
275
+ どうしたらFor Each内の処理に入ってくれるのか分かりません。
276
+
277
+
278
+
279
+ どなたかご存知の方がいたら教えていただきたいと思っております。
280
+
281
+
282
+
283
+ よろしくお願いいたします。

1

全体的に変更しました。

2020/03/04 03:34

投稿

退会済みユーザー
test CHANGED
File without changes
test CHANGED
@@ -4,7 +4,7 @@
4
4
 
5
5
  サイトはこちらを参考にしました。
6
6
 
7
-
7
+ [https://qiita.com/isamusuzuki/items/b2e88184e7cfb75877a8](https://qiita.com/isamusuzuki/items/b2e88184e7cfb75877a8)
8
8
 
9
9
  ### 【困っていること】
10
10
 
@@ -12,7 +12,7 @@
12
12
 
13
13
  それが「HTTPアクセスができない」ということです。
14
14
 
15
- 主に、記コードの
15
+ 主に、、参考にしたサイトのコードの中にある下記の部分で「サーバーへの接続に失敗しました」となってしまいます。
16
16
 
17
17
 
18
18
 
@@ -34,17 +34,13 @@
34
34
 
35
35
 
36
36
 
37
- 上記、この部分でエラーが出てしまいます。
38
-
39
37
 
40
38
 
41
39
  ### 【聞きたいこと】
42
40
 
43
41
 
44
42
 
45
- そこで、**HTTPアクセスができるようにするためにはどうしたらいいのかを知りたい**のですが
43
+ そこで、**上記URLのコードでHTTPアクセスができるようにするためにはどうしたらいいのかを知りたい**のですがどなたかご存知のかたはいらっしゃいますでしょうか?
46
-
47
- どなたかご存知のかたはいらっしゃいますでしょうか?
48
44
 
49
45
 
50
46
 
@@ -52,9 +48,23 @@
52
48
 
53
49
 
54
50
 
51
+ また、上記URLのコードでうまくいかなかったため、個人的にXMLを取得するプログラムを作ってみました。
52
+
55
- コードが今回のコードです。
53
+ それがコードです。
54
+
55
+
56
+
57
+ しかし、この下記コードでもやはりHTMLを除いたnewstitleとLocの情報を取得することができていません。
58
+
59
+ やはり、上記の通り、HTTPアクセスができないと難しい・・ということなのかなと思っています。
60
+
61
+
56
62
 
57
63
  よろしくお願いいたします。
64
+
65
+
66
+
67
+ ![イメージ説明](548350ca1b9995a7c17be8e397805d61.png)
58
68
 
59
69
 
60
70
 
@@ -62,81 +72,59 @@
62
72
 
63
73
 
64
74
 
65
- Sub Main()
75
+ Sub test()
76
+
77
+ Dim wbActive As Workbook 'アクティブワークブック
78
+
79
+ Dim strURL As String 'URL
80
+
81
+ Dim httpReq As XMLHTTP60
82
+
83
+ Set httpReq = New XMLHTTP60
84
+
85
+
86
+
87
+ 'アクティブワークブックをゲット
88
+
89
+ Set wbActive = ThisWorkbook
90
+
91
+ wbActive.Worksheets("Sheet1").Activate
92
+
93
+ strURL = wbActive.Worksheets("Sheet1").TextBox1.Text
94
+
95
+
96
+
97
+ httpReq.Open "GET", strURL
98
+
99
+ httpReq.send
100
+
101
+
102
+
103
+ Do While httpReq.readyState < 4
104
+
105
+ DoEvents
106
+
107
+ Loop
108
+
109
+
110
+
111
+ Debug.Print httpReq.responseText
112
+
113
+ '黄色のセルにXMLを表示
114
+
115
+ 'ここで本当はHTMLを除いたnewstitleとLocの情報を取得して、EXCELの列に一覧として並べたい
116
+
117
+ wbActive.Worksheets("Sheet1").Range("B10").Value = httpReq.responseText
118
+
119
+
120
+
121
+ Set httpReq = Nothing
66
122
 
67
123
 
68
124
 
69
- '変数の宣言
125
+ MsgBox "処理が終了しました"
70
126
 
71
- Dim http As XMLHTTP60
127
+
72
-
73
- Dim doc As DOMDocument60
74
-
75
- Dim node As IXMLDOMNode
76
-
77
- Dim url As String
78
-
79
- Dim i As Integer
80
-
81
-
82
-
83
- 'HTTPアクセスを設定して発射
84
-
85
- Set http = New XMLHTTP60
86
-
87
- url = "https://ja.wikipedia.org/w/api.php?action=query&list=recentchanges&rcnamespace=0&format=xml"
88
-
89
- http.Open "GET", url, False
90
-
91
- http.send
92
-
93
-
94
-
95
- 'HTTPアクセスに失敗があったら中止
96
-
97
- If http.statusText <> "OK" Then
98
-
99
- MsgBox "サーバーへの接続に失敗しました", vbCritical
100
-
101
- Exit Sub
102
-
103
- End If
104
-
105
-
106
-
107
- 'XMLデータを取り込む
108
-
109
- Set doc = New DOMDocument60
110
-
111
- doc.LoadXML (http.responseText)
112
-
113
-
114
-
115
- 'XPathを使ってノード(要素)を取り込む
116
-
117
- i = 1
118
-
119
- For Each node In doc.SelectNodes("//rc")
120
-
121
- '各ノードのtitle属性を取得して、シートに貼り付ける
122
-
123
- ActiveSheet.Range("A" & i + 2).Value = i & ": " & node.Attributes.getNamedItem("title").Text
124
-
125
- i = i + 1
126
-
127
- Next
128
-
129
-
130
-
131
- '後片付け
132
-
133
- Set http = Nothing
134
-
135
- Set doc = Nothing
136
-
137
- Set node = Nothing
138
-
139
-
140
128
 
141
129
  End Sub
142
130