• ベストアンサー
  • 困ってます

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

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数1293
  • ありがとう数3

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

  • ベストアンサー
  • 回答No.1

>状態待ちかと思い待機コードをビシバシ突っ込みましたが 「objIE.ReadyState <> 4 」も追加してみては? While objIE.ReadyState <> 4 Or .Busy DoEvents Wend >If objLink.Href = ・・・​ Then '←F8ステップ実行ではOKだが、通常処理では判定されない? どこを処理して、どこを処理していないのかが不明なわけですね。 >If objLink.Href = ・・・​ Then の次に WorkSheets("Sheet1").Range("A1").Value=objLink.Href を追加して、If文が判定されているかを確認してはどうでしょう。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答ありがとうございます。 >「objIE.ReadyState <> 4 」も追加してみては? .Document.forms(0).submit      の直下で While objIE.ReadyState <> 4 Or .Busy DoEvents Wend とすることで、無事解決できました。 >どこを処理して、どこを処理していないのかが不明なわけですね。 質問投稿後に思いついて >For Each objLink In objIE.Document.frames("right").Document.Links >If objLink.Href = "​https://www2.hogehoge/~" Then の間で Msgbox(objLink.Href) としたら何の反応もなかったので「フレーム内の読み込みが終わらないうちにVBAコードが走っているのでは?」と考えていました。 #2氏ご提示のサイトでも objIE.ReadyState <> 4 の類は示されていたのですが自らコーディングできなかったですね・・・。 おかげさまでスムーズに目的のサイトを開くことができるようになりました。ありがとうございます。

その他の回答 (1)

  • 回答No.2
  • Wendy02
  • ベストアンサー率57% (3570/6232)

こんばんは。 あまり、こういう質問には良いアドバイスが出来ません。結局、ログを取って、そこから読んでいただくしかありません。ログから、Excelでタグの一覧を取る方法もありますから、以下のリンク先の「三流君VBA」を参考にしてみてください。 http://www.ken3.org/cgi-bin/group/vba_ie.asp#Input_Radio >If objLink.Href = "https://www2.hogehoge/BillList.jsp?init=false&search=pa... Then '←F8ステップ実行ではOKだが、通常処理では判定されない? 本当にそうなっているでしょうか?ソースを見ないといえないような気がします。だいたいは、途中からだと思います。ローカルウィンドウやDebug.Print で、その取った値を取ってみたほうがよいですね。 >objLink.Click  ’←要はこれをしたい! ソースから分かれば、それはそれでよいのですが、直接ではありませんが、要するに、タグを見つけることに他ならないと思います。 良いサンプルとして、上記に書いたサイトで、タグをExcelで一覧を出してみる方法がよいのではないかと思います。HTMLコードだけで辺りを付ければよいのですが、私自身も、タグの一覧から中りを付けています。 それと、 Application.Wait 3000 '1000分の1秒     ↓ Application.Wait TimeSerial(0,0,3) のことだと思います。 または、 Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) Sleep 3000 と書きます。

共感・感謝の気持ちを伝えよう!

質問者からのお礼

ご回答いただきありがとうございます。 >以下のリンク先の「三流君VBA」を参考にしてみてください。 このサイトを参考に2日間格闘した結果が質問コードでした(^^;; >Application.Wait 3000 '1000分の1秒 >    ↓ >Application.Wait TimeSerial(0,0,3) >のことだと思います。 ご指摘ありがとうございます。 >.Document.forms(0).submit     '←ここまではOK >Application.Wait 3000 '1000分の1秒 >Do While .Busy = True >DoEvents >Loop 上記を Application.Wait TimeSerial(0,0,3) に修正したところ、なんと直下のDo~Loopが抜けなくなりました(@_@)? なんとか自分で調べてみようと思います。 また何かの機会でご教授いただくことがあるかも知れませんが、その際は宜しくお願いします。

関連するQ&A

  • VBAでオブジェクトがありません、となってしまう

    VBAを実行すると、 実行エラー424 オブジェクトが必要です。 となってしまいます。 エラーとなっている行は、 .Document.getElementById("q_d").Value = ActiveSheet.Cells(rowno, 1).Value です。 作成したリストは、以下のようになっています。 Sub MAP住所() Dim objIE As Object, rowno As Integer rowno = 1 Set objIE = CreateObject("InternetExplorer.Application") With objIE 'Google Map起動 .Navigate "http://maps.google.co.jp/" .Visible = True Do While (ActiveSheet.Cells(rowno, 1).Value <> "") 'IE待機 Do While .Busy = True DoEvents Loop '住所をテストボックスへ入力 .Document.getElementById("q_d").Value = ActiveSheet.Cells(rowno, 1).Value '送信ボタンクリック .Document.forms(0).submit '次の行 rowno = rowno + 1 Loop End With Set objIE = Nothing End Sub A列にある住所を読み込んで、グーグルマップに表示するスクリプトになります。 どう直して良いのか、皆目わかりません 御指南願います

  • vbaでyahooメールの受信メールの一覧を読み取

    vbaでyahooメールの受信メールの一覧を読み取る方法はありますか? Sub test() Dim objIE As InternetExplorer Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "http://login.yahoo.co.jp/config/login?logout=1" 'ログアウトする Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop objIE.Navigate "https://login.yahoo.co.jp/config/login?.src=&.pd=&.done=http%3A//www.yahoo.co.jp/" Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop objIE.Document.all.UserName.Value = "" objIE.Document.all.passwd.Value = "" Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop objIE.Document.Forms(0).submit Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop objIE.Navigate "http://jp.mc1003.mail.yahoo.co.jp/mc/welcome?.rand=6i0loli2li7s6&noFlush&YY=940152127#_pg=showFolder&fid=Inbox&order=down&tt=84&pSize=25&.jsrand=6381767" Do While objIE.Busy = True Or objIE.ReadyState <> 4 DoEvents Loop Debug.Print objIE.Document.Body.innerHTML Set objIE = Nothing End Sub これでログインまではできるのですが、その後のソースを読み取っても受信メールの一覧は読み取れません。 ログイン後に、vbaではなく手動でWEBクエリをやってソースに書き出してみましたがやはり受信メールだけは読み取れません。 WEBクエリならフォルダの一覧は読み取れました。 VBAで読み取るのは不可能なのでしょうか?

  • 【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 よろしくお願いいたします

  • オブジェクト変数または 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で教えてgooに自動ログインしたい

    Sub 教えてgoo() Dim objIE As Object Const READYSTATE_COMPLETE As Long = 4 Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "https://login.mail.goo.ne.jp/id/authn/LoginStart?Site=oshiete.goo.ne.jp&Success=http%3A%2F%2Foshiete.goo.ne.jp%2F" Do While objIE.Busy = True DoEvents Loop Do Until objIE.ReadyState = READYSTATE_COMPLETE Loop objIE.document.all.all("uname").Value = "gooID" objIE.document.all.all("pass").Value = "gooPW" Do While objIE.Busy = True DoEvents Loop Do Until objIE.ReadyState = READYSTATE_COMPLETE Loop objIE.document.all("ログイン").Click End Sub --------------------------------------------------------- を実行してみても、 objIE.document.all.all("uname").Value = "gooID" objIE.document.all.all("pass").Value = "gooPW" objIE.document.all("ログイン").Click の部分がエラーになってしまいます。 教えてgooは、VBAでログインできないように規制されてるのでしょうか?

  • 「地図」で検索するにはどういう操作をすればいいので

    ヤフーのトップページから 値を入れて検索を押すまではできるのですが 「ウェブ」ではなく「地図」で検索するにはどういう操作をすればいいのでしょうか? Sub yahoo() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True objIE.Navigate "http://www.yahoo.co.jp/" Do While objIE.Busy = True DoEvents Loop Do While objIE.Document.ReadyState <> "complete" DoEvents Loop objIE.Document.forms(0).elements("p").Value = "東京" '‘「地図」をクリックする操作をしたい objIE.Document.forms(0).submit Set objIE = Nothing End Sub 宜しくお願いいたします。

  • vb2010webページのリンクをクリック

    vb2010でwebページのリンクをクリックしたいのがうまくいきません。 「ホーム」などは選択することができるのですが、「翌月」などが選択できません。コードは以下のようになっています。どなたか教えていただけないでしょうか。 Dim objIE Dim objLINK objIE = CreateObject("InternetExplorer.Application") objIE.Visible = True 'IEウィンドウを表示 objIE.Navigate2("http://www.data.jma.go.jp/obd/stats/etrn/view/daily_s1.php?prec_no=44&prec_ch=%93%8C%8B%9E%93s&block_no=47662&block_ch=%93%8C%8B%9E&year=2000&month=01&day=&view=p1") Do Until objIE.Busy = False Application.DoEvents() Loop For Each objLINK In objIE.Document.Links If objLINK.InnerText = "翌月" Then objLINK.Click() Do Until objIE.Busy = False Application.DoEvents() Loop Exit For End If Next

  • ラジオボタンをクリックしたい

    ie操作です。宜しくお願いいたします。 郵便局の再配達の依頼をvbaで行おうとしているのですが ラジオボタンにチェックする方法がわかりません。 「簡易・記録」にチェックを入れたいです。 https://trackings.post.japanpost.jp/delivery/delivery_request.do のソースを見ると、 <DIV><FONT class="explain_font_normal"> <input type="radio" name="mailTypeCode" value="13">簡易・記録 </FONT></DIV> となっているので Sub test1() Dim objIE As Object Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate "https://trackings.post.japanpost.jp/delivery/delivery_request.do" objIE.Visible = True Do While objIE.Busy = True DoEvents Loop Do While objIE.document.ReadyState <> "complete" DoEvents Loop objIE.document.forms(0).elements("mailTypeCode") = 13 objIE.document.all("mailTypeCode").Value = 13 objIE.document.all.forms(0)("mailTypeCode").Value = 13 Set objIE = Nothing End Sub としてみましたが、どれもダメでした。 宜しくお願いいたします。

  • VBAでSkyDriveにログインしたい

    VBAでSkyDriveにログインしたいのですが、 --------------------------------------------------------- Sub SkyDriveにログインする() Set objIE = CreateObject("InternetExplorer.application") objIE.Visible = True objIE.Navigate "https://login.live.com/login.srf?wa=wsignin1.0&rpsnv=11&ct=1340539242&rver=6.1.6206.0&wp=MBI_SSL_SHARED&wreply=https:%2F%2Fskydrive.live.com%2F%3Flc%3D1041&lc=1041&id=250206&mkt=ja-JP&cbcxt=sky" '表示終了まで共通_表示待ち Do While objIE.Busy = True DoEvents Loop objIE.Document.all.PageID.Value = "aaa" objIE.Document.all.passwd.Value = "aaa" '表示終了まで共通_表示待ち Do While objIE.Busy = True DoEvents Loop objIE.Document.Forms(0).submit Set objIE = Nothing End Sub --------------------------------------------------------- を実行すると、 objIE.Document.all.PageID.Value = "aaa" の部分で、 【オブジェクトは、このプロパティまたはメソッドをサポートしていません。(Error 438)】 というエラーになります。 たぶん、「PageID」が間違ってると思うのですが、ソースを見てもよくわかりません。 ご教授いただけないでしょうか? ご回答よろしくお願いします。

  • DoEvents

    VBSでDoEventsは使えないのでしょうか? *************************** Dim ObjIE dim i Set ObjIE = CreateObject("InternetExplorer.Application") ObjIE.Navigate "http://oshiete.goo.ne.jp/" ObjIE.Visible = True Do While ObjIE.Busy = True DoEvents Loop Do While ObjIE.Document.ReadyState <> "complete" DoEvents Loop Set ObjIE = Nothing *************************** だと、エラーになりました。 Wscript.sleep 3000 ならエラーにならずにコードは動きました。 VBAならDoEventsは使えるのに VBSで使えない理由を教えてください。