- ベストアンサー
エクセルVBAで、Yahooの路線の片道料金を取得する
A2に(出発地の)大阪、 B2に(目的地の)名古屋とあったら、 C2に(運賃:片道)6,180円が入るようにしたいのです。 コードを教えて頂きたく御願いします。 (この部分しか書けませんでした。) Sub test() Dim IE Set IE = CreateObject("InternetExplorer.Application") IE.Navigate "http://transit.map.yahoo.co.jp" IE.Visible = True IE.Quit SetIE = Nothing End Sub
- NEWYORKERS
- お礼率98% (92/93)
- オフィス系ソフト
- 回答数3
- ありがとう数3
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
こんばんは。 失礼しました。ADO を参照設定ままで、作っていたので、それを外さずに動かしていたからです。 >Private Function Encode_Uni2UTF(ByRef strUni As String) >のところで止まります。 止まる理由はよく分かりませんが、以下のようにすればよいはずです。 ただ、金額は、日時設定していませんから、値段が変わります。 ひとつのまとまりを、以下に、そのまま上書きしてしてください。 '------------------------------------------- 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
その他の回答 (2)
- Wendy02
- ベストアンサー率57% (3570/6232)
こんにちは。 複数の運賃を探す場合は、ループするか、正規表現を使わなくてはなりませんが、とりあえず、参考までコードを書いておきます。今回は、最初に出てくるものだけを取り出しています。 本来、正規表現での取得のほうが、いろんな面で失敗が少ないのですが、私は、検索スピードが落ちるような気がしています。細かい部分は、もう少し手を加えなくてはなりません。 なお、ヤフーは、年に一度か二度はHTMLコードを書き換えますので、結構、泣かされます。だから、やはり正規表現のほうが便利です。それは、研究してください。 ワークシートにボタンを置いて、A1,A2 に書いてあげれば、A3に、金額が出てきます。 例: Private Sub CommandButton1_Click() Call GetFareTest1 End Sub 出力例: A1:大阪 A2:名古屋 A3:6,180円 なお、失敗したときも表示します。 '------------------------------------------- '標準モジュール '------------------------------------------- '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("A1").Value) sDST = Encode_Uni2UTF(Range("A2").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("A3").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" 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
お礼
御回答を有難うございます。 Private Function Encode_Uni2UTF(ByRef strUni As String) のところで止まります。 (ボタンを作成し、標準モジュール1にコピペしました。 A1に大阪、A2に名古屋と手入力してあります。) すみませんが宜しく御願いします。
- fujillin
- ベストアンサー率61% (1594/2576)
ざっとの、方法のみですが… 1)大阪、名古屋をエンコードしてURLのサーチ部分に追加したものを 表示させる。(手動で検索するのとほぼ同じ) 例の場合だと from=%E5%A4%A7%E9%98%AA&to=%E5%90%8D%E5%8F%A4%E5%B1%8B 2)表示された結果のソースから「<dl class="price">」や「運賃:」 などをキーに料金を検索。(この例だと3箇所みつかるはず) 3)検索された料金を表示。 (3箇所 6,180円、6,410円、5,980円からどの様に選択して表示する のかはご質問文からは不明) 具体的な方法のヒントはこのあたりにあると思います。 http://www2s.biglobe.ne.jp/~iryo/vba/IE/index01.html しかし、実際には、 この他にもパラメータがいろいろあるので、それを無視して利用しても全ての場合に正しい結果が得られるのか不明。 (利用設定や日付などによって料金が変わると思われる) 入力値が不正な場合のチェックをどうするのか? 例のように結果の料金がいろいろある場合にどれを採用するのか? などなど、ご質問文だけでは不明な点がいろいろあります。 コーディングで行うには、これらの起こり得る可能性について対処しておく必要があるので、かなり複雑になるでしょう。 (例えば、IEのトラブルや、ネット環境が何らかの不具合で繋がらないなどの場合に、値を取ろうとしても即エラーになりますよね?) また、ご提示のサイトの仕様が変更された時はどうするのかなどなど、他にもいろいろ問題がありそうな気がします。 (そもそも、このような利用ってありなのと言う気がしないでもない) それなので、ご提示のように検索画面を表示させて、「大阪」、「名古屋」をそれぞれ出発地、目的地の欄にコピーするぐらいまでにしておいた方が宜しいような気がしますが…(あとの操作はユーザにさせる)
お礼
早速の御回答を有難う御座います。 御指摘のとおりすごく曖昧ですみません。 自分だけが使うので、起こり得る可能性に関しては とりあえず、置いといて、まず、料金の取得方法を知りたいと思いました。 会社内で、旅費交通費の金額が間違いなく請求されているかをチェックするのに、 何回も繰り返して調べているので、 何か良い方法がVBAを使用して出来ないかと思っています。
補足
検索された金額で、最初のものを使用しています。
関連するQ&A
- 複数のタブを開きたい IE
IE9を使っています。 画像のようにタブを二つ開くにはどうすればいいでしょうか? Sub test() Dim objIE As InternetExplorer Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" Set objIE = Nothing End Sub だと一つのタブしか開けません。 Sub test() Dim objIE As InternetExplorer Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" objIE.Navigate "http://www.yahoo.co.jp/" Set objIE = Nothing End Sub にしても Sub test() Dim objIE As InternetExplorer Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" objIE.Navigate2 "http://www.yahoo.co.jp/" Set objIE = Nothing End Sub にしても1つのタブしか開けないです。 ご回答よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBAでIE操作をするサンプル
VBAでIE操作をするサンプルをネットでいくつか見ているのですが Sub Sample1() Dim objShell As Object Dim objIE As New InternetExplorer Set objShell = CreateObject("Shell.Application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" Set objIE = Nothing Set objShell = Nothing End Sub Sub Sample2() Dim objIE As InternetExplorer Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" Set objIE = Nothing End Sub ではどちらを使った方がいいのでしょうか? 圧倒的にSample2の方がネットでは多いのですが Sample1のやり方もあることを知りました。 Sample1の方法でブラウザを開くメリットはあるのでしょうか?
- ベストアンサー
- Visual Basic
- ie 64bit 32bit どちらが開いてる?
Sub Sample() Dim objIE As InternetExplorer Set ObjIE = CreateObject("InternetExplorer.application") ObjIE.Visible = True ObjIE.Navigate "http://www.yahoo.co.jp/" Set ObjIE = Nothing End Sub で、vbaからieを開いた場合、64bit 32bitのどちらで開かれるのでしょうか? 私の環境はwin7、IE9です。
- ベストアンサー
- オフィス系ソフト
- Excel VBA IEの終了方法は?
お世話になっています。 検索しましたが判らなかったので質問します。 VBAでIEを起動します。 Sub IE起動() Set IE = CreateObject("internetExplorer.application") IE.Visible = True IE.navigate ("http://www.goo.ne.jp") End Sub ここまでは出来ました。 --<質問内容>------ では、IEを終了するには?
- ベストアンサー
- オフィス系ソフト
- VBAでyahooをログアウトしたい
VBAでyahooにログインすることはできたのですが、 VBAでログアウトしたいです。 Sub yahoo() Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" ログアウトするコード ・ ・ ・ End Sub まではわかりました。自分なりには頑張りました。 IE9を使ってるのですが そもそもソースの見方がわかりません。 ご教授よろしくお願いします。
- ベストアンサー
- Visual Basic
- 二つ目のタブを閉じたい
http://hiroba.chintai.net/qa7823804.html こちらでも質問したものです。 xls88さまに教えていただいて、 Sub test() Dim objIE As InternetExplorer Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.navigate "http://www.yahoo.co.jp/" objIE.Navigate2 "http://www.goo.ne.jp/", 2048 objIE.Navigate2 "http://www.google.co.jp/", 2048 objIE.Quit Set objIE = Nothing End Sub で、複数のタブを開くことができたのですが、 http://www.goo.ne.jp/のタブだけを閉じたい場合はどうすればいいでしょうか? 上記のコードを実行すると、http://www.yahoo.co.jp/が閉じてしまいます。 ご回答よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- IEではなくファイアフォックスを指定することは
VBAでブラウザを開く場合、 IEではなくファイアフォックスを指定することは可能ですか? 既定のブラウザはIEにしています。 Sub test1() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate "http://www.ocn.ne.jp/" objIE.Visible = True Set objIE = Nothing End Sub の Set objIE = CreateObject("InternetExplorer.Application") の部分を Set objIE = CreateObject("firefox.exe") に変えてみたら、 【ActiveX コンポーネントはオブジェクトを作成できません。(Error 429)】 になりました。
- ベストアンサー
- Visual Basic
- エクセルVBAでIEのjavaスクリプトが切れるでしょうか
色々試してみたのですができないので質問させてください。 エクセルのハイパーリンクであるホームページに飛びたいのですが そこがトップから入らないとそのページに直接アクセスできません。 そこでバックグラウンドでIEのトップを開いてその後にリンクで飛ばしたいのですがうまくいきません。 JAVAスクリプトでトップページに戻しているようなのでリンクで飛ぶ前 にIEのJAVAスクリプトを切ってとんだ後にJAVAをONにできますでしょうか? 今はこんな感じです。 Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) Dim objIE As Object Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = False objIE.Navigate "http://www.google.co.jp/" Application.Wait Time:=Now + TimeValue("00:00:03") objIE.Quit Set objIE = Nothing End Sub 今はgoogleとしています。 IEで戻るを押せば行きたいところに入ることもできます。 飛んだ後に戻るを自動で押すようなこともできますでしょうか?
- ベストアンサー
- オフィス系ソフト
- vbaでIEを閉じるだけの処理
オフィス2003を使用しています。 「IEを開いて閉じる」は Sub TEST() Set ObjIE = CreateObject("InternetExplorer.application") ObjIE.Visible = True '見えるようにする '文字列で指定したURLに飛ぶ ObjIE.navigate "http://www.yahoo.co.jp/index.html" '表示終了まで待つ Do While ObjIE.Busy = True DoEvents Loop ObjIE.Quit End Sub と言うことがわかったのですが 開くのは他の作業をしたときに行うので 「閉じる」だけをvbaで行いたいのですがどうすればいいのかわかりません。 Sub TEST2() Set ObjIE = CreateObject("InternetExplorer.application") ObjIE.Visible = True '見えるようにする ObjIE.Quit End Sub だと また新たなIEが起動してしまい「現在起動しているIEを閉じる」と言うことができません。 アドバイスをお願い致します。
- ベストアンサー
- オフィス系ソフト
- インターネットで調べてVBSで下のようなものを作ってみました。
インターネットで調べてVBSで下のようなものを作ってみました。 やりたいことは、IEを起動して複数のサイトを複数のタブで表示 したいのですが、サイトの種類分IEも起動してしまいます。 考えているようなことはできないのでしょうか。 ========ここから下です======== Option Explicit Dim objIE Dim objShell 'Shell.Application Set objShell = CreateObject("Shell.Application") Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True 'IEウィンドウを表示 objIE.Navigate2 "http://www.okwave.jp/" Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True 'IEウィンドウを表示 objIE.Navigate2 "http://www.google.co.jp/" Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True 'IEウィンドウを表示 objIE.Navigate2 "http://www.yahoo.co.jp/" ======================= よろしくお願いいたします。
- ベストアンサー
- その他(プログラミング・開発)
お礼
まるごと全部作成して頂き、本当に感謝の気持ちでいっぱいです。 頭が良いと、こんなに業務が楽になるんだなあとつぐつぐ思います。 今の私のレベルでは、難し過ぎて解読出来ないので、 そのまま使用させてもらうのですが、理解出来る様に、 勉強を続けたいと思います。 御指導有難うございました。