VBAでURLを指定する方法

このQ&Aのポイント
  • VBAを使用して、エクセルに記載しているテキストで開くURLを変えるプログラムを作成する方法について説明します。
  • 現在、特定のURLを開くVBAプログラムがありますが、このプログラムを流用してテキストに応じて異なるURLを開けるようにする方法も解説します。
  • VBAを使用して、エクセルの特定のセルに入力されたテキストに基づいて異なるURLを開くプログラムを作成する方法について詳しく説明します。
回答を見る
  • ベストアンサー

VBAでURLを指定する方法

VBAを使用して、エクセルに記載しているテキストで開くURLを変えるプログラムを作成しようと思っております。 例えばA1に『yahoo』と入力されていれば、『http://www.yahoo.co.jp/』を開き、 『google』と入力されていれば、『http://www.google.com』を開くようにしたいです。 現在、下記のプログラムを使用していますので、 下記を流用できるようにして頂けると幸いです。 Sub test() Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "『特定URL』" Do While objIE.ReadyState <> 4 Do While objIE.Busy = True Loop Loop For Each Obj In objIE.Document.getelementsbytagname("input") If Obj.Name = "mail" Then objIE.Document.getelementsbyname("mail")(0).Value = Range("C1").Value Else If Obj.Name = "password" Then objIE.Document.getelementsbyname("password")(0).Value = Range("D1").Value Else objIE.Document.Links(1).Click End If End If Next End Sub 宜しくお願いいたします。

質問者が選んだベストアンサー

  • ベストアンサー
  • GADNET
  • ベストアンサー率35% (7/20)
回答No.1

インターネットネットアクセスタイミングがわからなかったので セルA1が変更されたときのプログラムをさくせいしました。 Private Sub Worksheet_Change(ByVal Target As Range) Dim urlA1 As String 'URL変更用 Dim URL As String, IE As Object If Target.Row = 1 And Target.Column = 1 Then 'A1が変更された場合 Select Case Range("A1") Case "yahoo" urlA1 = "yahoo.co.jp/" Case "google" urlA1 = "google.com" Case Else MsgBox ("不明なURL") Exit Sub End Select Set IE = CreateObject("InternetExplorer.Application") URL = "http://www." & urlA1 With IE .Navigate (URL) .Visible = True End With Set IE = Nothing End If End Sub 追加URL場合はcase文を増やしたりする必要があります。 大量のURLに対応させるためにはデータベースを作成したほうが お勧めです。

panmoba
質問者

補足

回答ありがとうございます。 コードを参考にさせて頂いたところ、希望していた通りの動きになりました。 あとひとつ教えて頂きたいのですが、データベースの作成はどうしたら良いのでしょうか?

関連するQ&A

  • VBA 実行時エラー1004 rangeメソッドは

    始めまして、VBA初心者です。 現在VBAプログラムを使って、サイトに自動ログイン出来るようにコードを作成しているのですが、『実行時エラー’1004’rangeメソッドは失敗しました。’_global’オブジェクト』とメッセージが出て、実行できません。 デバックをすると以下の11行目で黄色のバーが出ていました。いろいろと調べてみましたが、原因がわからずに止まってしまいました。 どなかた分かる方がいらっしゃいましたら教えて頂けますようにお願い致します。 コードは下記です。 Sub 無料スペースログイン() Set ObjIE = CreateObject("InternetExplorer.Application") ObjIE.Visible = True ObjIE.Navigate "http://mnnf.jp/signup/" Do While ObjIE.ReadyState <> 4 Do While ObjIE.Busy = True Loop Loop For Each Obj In ObjIE.Document.getElementsByTagName("input") If Obj.Name = "mail" Then ObjIE.Document.getElementsByName("mail")(0).Value = Range("A1").Value Else If Obj.Name = "password" Then ObjIE.Document.getElementsByName("password")(0).Value = Range("B1").Value Else Exit For If Obj.alt = "新規無料登録" Then Obj.Click Exit For End If End If End If Next End Sub

  • If~ElseIfが冗長なので修正したいが・・・

    If~ElseIf~Else~EndIfの文でかなり冗長な気がするのですがもっと見栄え良く書く方法はないでしょうか? 個人的にはForなんとかで出来るような気がしますがうまくいきません。 If objIE.Document.URL = strURL Then Set objIN = objIE.Document.getElementByTagName("INPUT") objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop If objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop ElseIf objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop ElseIf objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop ElseIf objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop Else objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop End If

  • VBSでフォームに値を繰り返し入れる方法で悩んでいます

    VBScriptでフォームに値を入れることを繰り返したいのですがどうもうまくいかずに悩んでいます。いい方法を教えて下さい。 指定ページを開いた後に If objIE.Document.URL = strURL Then Set objIN = objIE.Document.getElementByTagName("INPUT") objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop If objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop ElseIf objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop ElseIf objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop ElseIf objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop Else objIE.Document.URL <> strAfterLoginPage Then objIN(0).value = ID objIN(1).value = PASSWORD objIN(2).Click Do Until objIE.Busy = False WScript.sleep(250) Loop End If 以下省略 といったように1回でログインできなかった場合何度か入力するプログラムなのですが最初のElseIfの後のところで「オブジェクトがありません」となってしまいます。 ページも遷移してないのですが何故かオブジェクトがなくなってしまいます。 そういった対策をすればよいのでしょうか? お願いします。

  • VBAでJAVAをコントロール

    javascriptのリンクが、<a href="javascript:void(0);">なんたらかんたら</a> であれば記載のソースが通じるのですが、 【今回の問題】 【html部分】 onclick="javascript:updateDisp();return false;" alt="なんたらかんたら"><input type="hidden" name="allupdate" value="なんたらかんたら"> 【javascriptの部分】 function updateDisp(){ update_flg = window.confirm("なんたらかんたら"); if(update_flg == true){ document.updateForm.submit(); } else{ alert("キャンセルしました。"); } とやられた途端に全く通じなくなりました。 どのように回避したらよいでしょうか。 【今回のではなく前回の(javascript:void(0);)成功分】 Private Sub CommandButton99_Click() Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://xxxx/entry" Do While objIE.Busy = True DoEvents Loop Application.Wait (Now + TimeValue("00:00:03")) objIE.Document.all("ShopShopId").Value = Range("C8") objIE.Document.all("ShopPassword").Value = Range("C9") objIE.Document.forms(0).submit Application.Wait (Now + TimeValue("00:00:05")) For Each Obj In objIE.Document.getElementsByTagName("a") If Obj.innerText = "なんたらかんたら" Then Obj.Click Exit For End If Debug.Print objIE.LocationURL objIE.Navigate "xxxx/entry/entry_tops/all_update?prm=xxxxxxxxxxxxxxxxxxxxxxx" For i = 0 To objIE.Document.Links.Length - 1 If objIE.Document.Links(i).href = "javascript:void(0);" Then Application.Wait (Now + TimeValue("00:00:05")) objIE.Document.Links(i).Click Application.Wait (Now + TimeValue("00:00:05")) Exit For MsgBox "ループ抜け" End If Exit Sub Next Next objIE.Quit End Sub 上記は【今回の問題】に通じません。 'objIE.Navigate.Document.updateForm.fireEvent ("なんたらかんたら") 'objIE.Document.Script.updateDisp "javascript:document.updateForm.submit(true);" など試行錯誤しておりますが、javascriptのポップアップが回避できません。 どなたか何とかご教授お願いいたします。

  • VBAでWEBのリンクをクリックしたい

    取引先のWebサイトから請求書のデータを取得しようと思い、該当ページに到達すべくコードを書いてみました。 以下のコードを F8 キーでステップ実行を続けると目的を達するのですが、ボタンに割付て実行するとログイン後のページを表示した後目的のリンクをクリックできません。 状態待ちかと思い待機コードをビシバシ突っ込みましたが通常実行では目的のリンクをクリックしてくれません。 どうしたらよいでしょうか? Sub サイトオープン() Set objIE = CreateObject("InternetExplorer.Application") With objIE .Navigate "https://www2.hogehoge/Login.jsp" .Visible = True 'IE待機 Do While .Busy = True DoEvents Loop 'テストボックスへ入力 .Document.all.Item("userId").Value = Range("b1").Value .Document.all.Item("password").Value = Range("b2").Value '送信ボタンクリック .Document.forms(0).submit     '←ここまではOK    'IE待機 Application.Wait 3000 '1000分の1秒 Do While .Busy = True DoEvents Loop     ’フレーム内のリンク確認 For Each objLink In objIE.Document.frames("right").Document.Links If objLink.Href = "https://www2.hogehoge/BillList.jsp?init=false&search=???&page=Top" Then '←F8ステップ実行ではOKだが、通常処理では判定されない?      'IE待機 Do While .Busy = True DoEvents Loop  ’リンクをクリック          objLink.Click  ’←要はこれをしたい!        'IE待機      Application.Wait 3000 '1000分の1秒 Do While .Busy = True DoEvents Loop Exit For End If Next End With Set objIE = Nothing End Sub

  • vbaでnanacoにログイン(ie操作)

    私は「緑のパスワードがなくnanacoをお持ちの方」です。 カード記載の番号にはvbaで値を入れることはできるのですが、 nanaco番号に値を入れることとログインボタンを押すことができません。 ********************************************** Sub nanaco() Dim objIE As InternetExplorer Dim myObj As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.navigate "https://www.nanaco-net.jp/pc/emServlet" Do While objIE.Busy = True DoEvents Loop Do While objIE.document.readyState <> "complete" DoEvents Loop objIE.document.all("XCID").Value = "12345" objIE.document.all("SECURITY_CD").Value = "Password" For Each myObj In objIE.document.forms(0).all If TypeName(myObj) = "HTMLInputElement" Then If myObj.alt = "ログイン" Then myObj.Click Exit For End If End If Next Set objIE = Nothing End Sub ********************************************** これだとまずall("XCID").Value でエラーになります。 ソースでは、 <input name="XCID" tabIndex="1" class="txtBoxLogin" accessKey="1" type="text" maxLength="16" value=""/> となっておりますが、同じコードが二つあるからエラーになるのでしょうか? all("SECURITY_CD").Value は問題なくできます。 ソースにも、SECURITY_CDは一つしかないです。 次にログインボタンも二つあるのですが、 For Each myObj In objIE.document.forms(0).all If TypeName(myObj) = "HTMLInputElement" Then If myObj.alt = "ログイン" Then myObj.Click Exit For End If End If Next このコードを実行すると、多分上の方のログインボタンが押されてるようです。 なので、 Dim 二つ目 As Boolean For Each myObj In objIE.document.forms(0).all If TypeName(myObj) = "HTMLInputElement" Then If myObj.alt = "ログイン" Then If 二つ目 = True Then myObj.Click Exit For End If 二つ目 = True End If End If Next に変更してみたのですが、 どうやら If myObj.alt = "ログイン" Then になるのは、1回しかないようです。 うーん、うまくできません。 ご教授よろしくお願いします。

  • VBAで、デバッグをお願いします。

    作りたいプログラムはpartsno_01から、partsno_20までのテキストボックスに、エクセルのセルA1から、A20までにある製品番号を入力し、データをsubmitするものです。 Sub pn() Dim ObjIE As Object Dim ObjShell As Object Dim ObjWindow As Object Dim WinExist As Boolean WinExist = False Set ObjShell = CreateObject("Shell.Application") For Each ObjWindow In ObjShell.Windows If TypeName(ObjWindow.document) = "HTMLDocument" Then WinExist = True Set ObjIE = ObjWindow End If Next Set ObjShell = Nothing If Not WinExist = True Then MsgBox "製品番号検索を開いてください。" Exit Sub End If ObjIE.Visible = True Do While i < 21 i = 1 Set elements = ObjIE.document.getElementsByName("partsno_0" & "i") If elements Is Nothing Then Exit Sub End If elements.Item(0).Value = Worksheets(1).Cells(i, 1).Value i = i + 1 Loop End Sub で、 elements.Item(0).Value = Worksheets(1).Cells(1, 1).Value が常にエラーになります。 間違っていはいないと思うんですが・・・・。 何がいけないのでしょうか。

  • オブジェクト変数または With ブロック変数が設定されていません。

    下記の様に組みましたが、下記の★印の所で止まる様な事があります。 毎回止まるわけではないのですが、止まる時に「オブジェクト変数または With ブロック変数が設定されていません。」と表示されますが、 原因は何か?どの様にすればいいのか?など詳しく教えてください。 よろしくお願いします。 Sub test() Dim objIE As Object Dim strCOMMENT As String Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "http://" While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop 'データをセットする 'htmlドキュメント フォーム(0番目) アイテムに転記(代入)する objIE.Document.forms(0).Item("username").Value = "11111" objIE.Document.forms(0).Item("password").Value = "11111" While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Document.all.subm.Click While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop For Each link In objIE.Document.Links If link.href = "http://" Then link.Click End If Next While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop 'タイトル・コメントの読み込み strtitle = Sheets("sheet1").Range("k7") strCOMMENT = Sheets("sheet1").Range("k9") Application.WindowState = xlMinimized While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Document.forms(0).Item("title").Value = strtitle objIE.Document.forms(0).Item("comment").Value = strCOMMENT While objIE.readystate <> 4 While objIE.busy = True DoEvents ' Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Document.all.submit.Click While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop 'フォーム(0番目)を .Submit(確認) する objIE.Document.forms(0).getElementsByTagName("input")(11).Click '←★この部分で止まる時があります。 While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 6, Now()) Do While Now() < Wait_Time DoEvents Loop For Each link In objIE.Document.Links If link.href = "http://" Then link.Click End If Next While objIE.readystate <> 4 While objIE.busy = True DoEvents Wend Wend Wait_Time = DateAdd("s", 7, Now()) Do While Now() < Wait_Time DoEvents Loop objIE.Quit '.Quitで閉じる End Sub

  • 【VBA】IEのリンクを新しいタブで開く

    VBAでIEを制御しリンク(アンカー)<a href="***">を新しいタブで開くようにしたいのですが可能でしょうか? 仮にグーグルのトップページ(http://www.google.co.jp/)の『検索オプション』(http://www.google.co.jp/advanced_search?hl=ja)を新しいタブで開くとします 実際に開きたいリンクのURLは固定ではないためURLの指定では開けませんが、飛びたいリンクの文言(『検索オプション』)は固定です リンクに飛ぶ前に飛ぶ先のURLを取得する仕方か、Shift+Ctrl+クリックのようにリンクを新しいタブで開く方法を教えてください 一度普通にリンクに飛んでからURLを取得し、戻ってから新しいタブで開くぐらいしかできないのでしょうか? Sub 新しいタブで開く() Dim objIE As Object Dim objShell Dim URL As String Set objShell = CreateObject("Shell.Application") For n = objShell.Windows.Count To 1 Step -1 Set objIE = objShell.Windows(n - 1) If Right(UCase(objIE.FullName), 12) = "IEXPLORE.EXE" Then objIE.Navigate "http://www.google.co.jp/" Exit For End If Next Set objShell = Nothing objIE.Visible = True Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop For Each Obj In objIE.Document.getElementsByTagName("a") If Obj.innerText = "検索オプション" Then Obj.Click Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop URL = objIE.Document.URL objIE.GoBack Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop objIE.Navigate URL, CLng(&H800) Exit For End If Next End Sub よろしくお願いいたします

  • 三菱東京UFJ銀行に自動ログインしたいのですが

    どうもうまくできません。 ログインボタンが押せません。 Sub tset() Dim objIE As Object Dim i As Long Set objIE = CreateObject("InternetExplorer.Application") objIE.navigate "https://entry11.bk.mufg.jp/ibg/dfw/APLIN/loginib/login?_TRANID=AA000_001" objIE.Visible = True Do While objIE.Busy = True DoEvents Loop With objIE.document .all("KEIYAKU_NO").Value = "test" .all("PASSWORD").Value = "PASSWORD" End With For i = 0 To objIE.document.Links.Length - 1 If objIE.document.Links(i).innerHTML Like "*alt=ログイン*" Then objIE.document.Links(i).Click Exit For End If Next i For i = 0 To objIE.document.Links.Length - 1 If objIE.document.Links(i).innerText = "ログイン" Then objIE.document.Links(i).Click Exit For End If Next i End Sub でも、押せないのですが、ご教授いただけませんか? よろしくお願いします。