質問編集履歴
2
他の方からのアドバイスを受けて追記
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
全体的に変更しました。
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
|
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
|
-
|
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
|
|