|
エクセルに出発駅・到着駅を入力して自動で交通費を出したい。 vba自体も初心者なもので、合っているかどうかも分かりません。 出来れば画像の表が決められた様式なのでそちらに合うように作成したいのですが、どなたか良いお知恵を頂けないでしょうか。 宜しくお願い致します!! (補足)別のシートにて試験的に作成してみたvbaですが、取得失敗してしまいます。 またyahoo路線の「きっぷ優先」で検索をしたい形なのですが、どのようにしたら良いか分かりません・・。 A1:大阪 A2:名古屋 A3:6,180円 ボタンも作成してみました。 Private Sub CommandButton1_Click() Call GetFareTest1 End Sub '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.loco.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" 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 |
↑エクセルVBAのIE(InternetExplorer)操作で分からない事があればこちらの掲示板よりご質問ください^^
ExcelのVBA初心者入門↑こちらはExcelのVBAをマスターできるよう初心者向けのエクセルVBA入門コンテンツになります^^
こちらでは、エクセルVBAで実際に作成したIE(InternetExplorer)制御ツールをまとめています。自動ログインや情報収集など具体的に解説しています。IE(InternetExplorer)制御をされる方は参考にしてください。
こちらでは、これまでに紹介したIE(InternetExplorer)操作で便利な機能をツール化しています。無償でダウンロードできますので、目的に合わせたご利用ください。
こちらでは、IE(InternetExplorer)オブジェクトのメソッド・プロパティをまとめています。
こちらでは、エクセルVBAのIE(InternetExplorer)操作で利用されたVBA関数をまとめています。
こちらでは、エクセルVBAのIE(InternetExplorer)操作で利用されたステートメントをまとめています。ExcelのVBAで基本的な部分になりますので、しっかり理解しましょう。
こちらでは、これまでに作成したIE(InternetExplorer)操作で役立つサブルーチンをまとめています。
全てをコピーする必要はありませんが、目的に合わせたサブルーチンをご利用ください。
こちらでは、IE(InternetExplorer)制御の利用だけでなく、Excel全般で利用できるVBAコードです。エクセルVBAで役に立つものばかりですので、ご利用ください。