Excelとweb上をつなげて以下のようなことができればと考えております。
A列に出発駅
B列に到着駅
C列に運賃
D列に所要時間
以下の質問に似たような質問があり、コピペしてみたのすが、「取得に失敗」
とでるだけでうまくいきません。
過去の質問のURLも載せておきます。
どなたかお詳しい方ご教授頂ければ幸いです。
ttps://oshiete.goo.ne.jp/qa/5258945.html?from=recommend
↓
hをわざと抜いています。(はじかれないようにです。)
質問の中の
プログラムは以下です。
(列の指示のみ変更しています)
なにがダメなのかもわからない、ずぶの素人です。
ご教授のほどよろしくお願い致します。
'-------------------------------------------
'標準モジュール
'-------------------------------------------
'Option Explicit
Sub GetFareTest1()
Dim IE As Object
Dim myURL As String
Dim myContent As String
Dim buf As String
Dim sST As String
Dim sDST As String
'ヤフー運賃検索(Yahoo!路線情報)
myURL = "http://transit.map.yahoo.co.jp"
sST = Encode_Uni2UTF(Range("A2").Value)
sDST = Encode_Uni2UTF(Range("B2").Value)
If sST = "" Or sDST = "" Then MsgBox "セルに文字がありません。", 48: Exit Sub
myURL = myURL & "/search/result?from=" & sST & "&to=" & sDST
Set IE = CreateObject("InternetExplorer.Application")
With IE
'.Visible = True 'コメントブロックをしたら、表示する
.Navigate myURL
Do While .Busy
DoEvents
Loop
Do Until .ReadyState = 4
DoEvents
Loop
myContent = .Document.body.innerHTML
'情報が取れなくなったときは、ここでログを取る
.Quit
End With
Set IE = Nothing
'出力
Range("C3").Value = PickUpString(myContent, "片道")
End Sub
Function PickUpString(ByVal strContent As String, SearchTxt As String)
Dim buf As String
Dim i As Long
Dim j As Long
buf = Mid$(strContent, InStr(1, strContent, SearchTxt, 1) + 2, 40)
i = InStr(1, buf, ">", 1) + 1
j = InStrRev(buf, "</S", , 1)
If i * j > 0 Then
PickUpString = Mid$(buf, i, j - i)
Else
PickUpString = "取得に失敗"
End If
End Function
'-------------------------------------------
Private Function Encode_Uni2UTF(ByRef strUni As String)
Dim buf As Variant
Dim tbuf As Variant
Dim n As Variant
Const CSET = "UTF-8"
Const ADTYPETEXT = 2
Const ADTYPEBINARY = 1
Dim ADOstrm As Object 'ADODB.Stream
On Error GoTo ErrHandler
Set ADOstrm = CreateObject("ADODB.Stream") 'New ADODB.Stream
ADOstrm.Open
ADOstrm.Type = ADTYPETEXT
ADOstrm.Charset = CSET
ADOstrm.WriteText strUni
ADOstrm.Position = 0
ADOstrm.Type = ADTYPEBINARY
ADOstrm.Position = 3
buf = ADOstrm.Read()
ADOstrm.Close
Set ADOstrm = Nothing
For Each n In buf
tbuf = tbuf & "%" & Hex(n)
Next
Encode_Uni2UTF = tbuf
Exit Function
ErrHandler:
If ADOstrm Is Nothing = False Then ADOstrm.Close
Set ADOstrm = Nothing
End Function
No.4ベストアンサー
- 回答日時:
こんにちは。
[03:38] 身体を壊さないようにしてくださいね。
私は、不眠症で、通常は睡眠時間5時間以内ですが、こういうWeb開発をする時は、どんなに大きなものでも、徹夜で一気につくってしまいます。
もちろん、今回のは、一番簡単なWeb開発の基本ですから、長い時間は不要です。
(なお、開発におけるアクセス数は、極力増やさないように、せいぜい3回程度です。)
>例えば「結果の一番最初の運賃と所要時間のみを抽出すること」も可能ということでしょうか。
簡単です。
With objIE
j = Cells(Rows.Count, 3).End(xlUp).Row + 1
Set oFrom = .document.getElementById("sfrom")
oFrom.Value = Cells(j, 1).Value
Set oSt = .document.getElementById("sto")
oSt.Value = Cells(j, 2).Value
Set btnSrch = .document.getElementById("searchModuleSubmit")
btnSrch.Click
End With
Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
With objIE
Set oFare = .document.getElementsByClassName("fare")
Set oSmal = .document.getElementsByClassName("small")
'For i = 0 To oSmal.Length - 1
Cells(j, 3).Value = oFare(0).innerText
Cells(j, 4).Value = oSmal(0).innerText
'Next
End With
objIE.Quit
とクリック一回事なら、こうすればよいです。
>A列B列に100件ほどの出発駅と到着駅を並べ、調べたい場合は今は"A2"と"B2"としている部分を変更することで対応可能なものでしょうか。
これは、もし連続で取得するとなると、ちょっと事情が変わってきます。
つたないながらも、経験があるので、あえてネガティブなことを言うのですが、プログラムとしては、別のワザが必要になってしまいます。いちいち、Navigate でアクセスしていたら、いろんな負担が、増大してしまいます。また、数が多くなると、Web側の判定できないメッセージやエラー対策も必要になってきます。
しかし、それ以上に、自主規制が必要になるかもしれません。
昔、ハローワークの仕事探しの検索の時と同じルールを適用したほうがよいかもしれません。ハローワークはスクレイピング禁止ですが方法があります。相手のサーバーの負荷や迷惑を考えなくてはなりませんので、1分間に、60回は越えてはいけないとか、『自主規制』を設けないといけなくなります。ハローワークの人によるアクセスは、半端ではありませんが。
そこで、VBAのWait というコマンドの代わりに、Sleep というWin API関数を用いて、プログラムに負荷(weight?)を掛けます。
実際は、このプログラムは、スクレイピングともクローリングとも呼ばないのですが、ロボット収集として、相手サーバーからは目をつけられやすい、負担が増えると、相手側がチェックして、IPアドレスは記録されることは覚悟しなければなりません。NTT回線では、関西のほうが厳しかったと思います。
Yahooでは、ネットの専門の会社ですから、非常識なことはしませんが、最近でも、朝早く警察がいきなりやってきて、証拠もなしに自白を強要されたり、認めなければ、数週間にも渡る留置・勾留というものもあります。コードを見れば一目瞭然だと分かるはずなのに、それでも、警察は信用してくれないのです。何年たっても警察組織は、それを改める様子が見られないということです。
データを取得した後に気をつけること
一応のお約束としては、データは、個人で使い商用では用いないこと。
公開されている規約があれば、それに従うこと。
Webスクレイピングの注意事項一覧
https://qiita.com/nezuq/items/c5e827e1827e7cb290 …
今更ながら、元のコードを発表した頃は良かったですね。
今回の修正コードで、単発取得の場合
こんばんは。
今日は、帰ってすぐにパソコンを起動させ、新しい回答に歓喜し、何度もWindFallerさんの文章を読ませて頂きました。
その後、プログラムをコピーさせて頂き、色々な駅名を入れて楽しんでおります。
そして、
「自主規制」。
ハローワークの仕事探しの検索ルール
そういったものがあることを知らなかったのですが、
私にわかりやすいように教えて頂きあありがとうございます。
個人で使用するとしても、気を付けなければならないんですね。
そういったことは、全く考えておりませんでした。
始めたばかりの今、そういったことを教えて頂いたこと
感謝です。
今回のWindFallerさんのプログラム、私にとっては暗号でしかないのですが、
こうやって、ただの(?)Excelが魔法にかかったみたいな現象を目の当たりにして
もっときちんと学びたいという気持ちになりました。
子どもの頃、msxというパソコンの前進のようなものに夢中になって
本に書いてあるアルファベットを意味も解らず打っていたことを思い出しました。
壁打ちテニスのような本当に単純なゲームが出来上がった時は、どれだけ嬉しかったか。
あ、話しがそれました。すみません。
Sleep というWin API関数は
聞いたことをありますが、
まだ、どうやって使えばよいのかは分からないですが
「自主規制」の範囲内で
自分で調べてやってみようと思います。
また教えてください。
No.3
- 回答日時:
こんばんは。
そう言えば、私もこれ作っていますね。Yahooの画面をみて思い出しました。
元のコードの頃は、そういう書き方が主流だったというしかありませんね。
#2さんのご指摘はそのものズバリですが、私も、もう一度、見直す時期が来ているような気がします。一応、地名は駅名にしてくださいね。名称の最後に駅がとつくので、「東京駅」「名古屋駅」とかします。IE は、Visible を立てませんので、エラーの時は、IEが潜ってしまうことがあります。その場合は、タスクマネージャーで消してください。本来は、Errorトラップを置くべきかもしれません。
とても簡単な内容ですから、参考にしてみてください。
今は、選択肢が多すぎることを予想していません。あまり多くを試したわけではありませんし、以前は、経由とか時間まで入れた記憶があります。しばらく様子をみてください。
'//
Sub GetFareTest2()
'事前バインディングで、Internet Control を参照設定しておきます。
Dim objIE As SHDocVw.InternetExplorer
Dim i As Long, j As Long
Dim oSt, oFrom, btnSrch, oFare, oSmal
Set objIE = New SHDocVw.InternetExplorer
If Range("A2").Value = "" Or Range("B2").Value = "" Then Exit Sub
If Not (Range("A2").Value Like "*駅" And Range("B2").Value Like "*駅") Then
MsgBox "駅名を入れたください。", vbExclamation
Exit Sub
End If
objIE.Navigate2 "https://transit.yahoo.co.jp/"
Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
With objIE
Set oFrom = .document.getElementById("sfrom")
oFrom.Value = Range("A2").Value
Set oSt = .document.getElementById("sto")
oSt.Value = Range("B2").Value
Set btnSrch = .document.getElementById("searchModuleSubmit")
btnSrch.Click
End With
Do While objIE.Busy Or objIE.readyState <> 4: DoEvents: Loop
j = Cells(Rows.Count, 1).End(xlUp).Row
With objIE
Set oFare = .document.getElementsByClassName("fare")
Set oSmal = .document.getElementsByClassName("small")
For i = 0 To oSmal.Length - 1
Cells(i + j, 3).Value = oFare(i).innerText
Cells(i + j, 4).Value = oSmal(i).innerText
Next
End With
objIE.Quit
Set objIE = Nothing
End Sub
夜分に失礼致します。
この度は、丁寧に、そして、プログラムを組んで下さりありがとうございます。どうにかWindFallerさんの画像のように実行することができました!!本当にありがとうございます。
そして、おこがましいとは知りつつ、さらに質問なのですが、A列B列に100件ほどの出発駅と到着駅を並べ、調べたい場合は今は"A2"と"B2"としている部分を変更することで対応可能なものでしょうか。もしくは、そんな簡単に出来るものではないでしょうか。
またWindFallerさんが教えて下さっている通り「選択肢が多すぎることを予想していません。」とのことですので、例えば「結果の一番最初の運賃と所要時間のみを抽出すること」も可能ということでしょうか。
本当は答えをそのままお教え頂きたい気持ちがありますが、ヒントだけでもご教授頂ければ助かります。
どうぞよろしくお願い致します。
No.2
- 回答日時:
こんにちは
参考になさった過去の質問を見ればわかると思いますが、web上のサービス(具体的にはYahooの路線と運賃の検索)をそのまま利用して表示しているだけのものです。
>「取得に失敗」とでるだけでうまくいきません。
今現在、http://transit.map.yahoo.co.jp にアクセスしてみればわかると思いますが、当時のサービスは終了しているようです。
(元の質問は2009年なので…。他で継続しているのかも知れませんが、少なくともアドレスは変わっています。)
それなので、検索以前に指定サイトにリクエストを送っても結果が表示されないので、「取得に失敗」ということになっているのでしょう。
>なにがダメなのかもわからない、ずぶの素人です。
…ということなので、コードの内容というよりも、利用していたサイトが(指定のURLには)ないので、機能しなくなっているということです。
早速返答ありがとうございます。
URLを現在のものに変更しても
https://transit.yahoo.co.jp
機能しません。
何か他に間違っているところがあればよろしくお願い致します。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) オブジェクトが見つかりません 1 2023/06/24 19:43
- Visual Basic(VBA) ExcelVBAに関する質問 3 2023/02/17 10:47
- Visual Basic(VBA) VBAが止まります。 3 2022/08/31 14:09
- Visual Basic(VBA) VBAでoutlook365が起動しません。 4 2022/08/25 13:31
- Visual Basic(VBA) フォルダの場所を可変にしたいです(マクロ) 4 2023/05/11 10:00
- Visual Basic(VBA) エクセルVBAのコードで質問です。 下のコードはJ16の文字列をB3を起点とする範囲から探して、見つ 5 2023/04/07 11:07
- Excel(エクセル) エクセル VBA For Next 繰り返しの書き方を教えてください 6 2022/09/01 14:11
- Excel(エクセル) 2つのVBAを一緒にしたら機能しなくなりました(エクセル) 7 2022/06/02 12:41
- Visual Basic(VBA) 稀に1円合いません? Sheet1から金額と個数を貼り付ける下記コードで、金額を切り上げるコードを何 3 2022/09/05 15:11
- Visual Basic(VBA) 別シートから年齢別の件数をカウントしたいの続き 5 2023/01/24 00:16
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
JavaScript window.openで開く...
-
showModalDialogで開いた画面を...
-
javascriptの基本的なことだと...
-
DOM要素を削除しても、イベント...
-
window.onloadを複数実行したい...
-
Latexに関する質問です。
-
excle VBA とweb上の検索を利用...
-
iframeのソースを取得したい
-
javascriptのdocument.allにつ...
-
ie操作 フレームのURLが...
-
Null またはオブジェクトではあ...
-
google マップ サイズ変更
-
オンマウスについて
-
ドロップダウンメニューを短縮...
-
このjavascriptのif文、条件式...
-
IEのイベントでのウインドウ...
-
Boolean型配列中のTrueの有無を...
-
ActiveXobjectが作成できない
-
C#テキストボックスの文字を配...
-
<a>タグのテキストを取得
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
codejump 模写コーディングgall...
-
このjavascriptのif文、条件式...
-
文字を一文字ずつ表示
-
DOM要素を削除しても、イベント...
-
FireFoxのjavascriptで自動でキ...
-
Javascriptのhtml出力についてa...
-
excle VBA とweb上の検索を利用...
-
Null またはオブジェクトではあ...
-
webページ上のTabキーの動き
-
XMLでのAttributeを持ったNode...
-
JavaScript window.openで開く...
-
ブラウザのウィンドウサイズに...
-
javascriptのdocument.allにつ...
-
javascriptの基本的なことだと...
-
responseTextについて
-
showModalDialogで開いた画面を...
-
iframeのソースを取得したい
-
removeEventListenerの必要性
-
クリッカブルマップのリンク部...
-
ラジオボタンをクリックしたい
おすすめ情報
このようにできました!ありがとうございます!!