ExcelのVBAで、Webサイトのあるリンクのリンク先の取得方法について追加質問致します。


【1】該当のページのURLは固定…なのですが、実はあるページから複数のプルダウンを選択し、
   送信ボタンを押下した結果表示されます。
   (ですので、この画面遷移を得ず直に閲覧先のページのURLを指定してしまうとエラー
    ページになってしまいます。)
【2】この該当のページに貼られている2つのリンクのうち、1つめのリンク先URLを取得で
   きればOKです。
【3】一定の選択肢で【1】の画面遷移から得られた該当ページであっても、【2】で得られ
   る1つめのリンク先URLはランダム生成です。

このような条件なのですが、
・該当ページの情報を取得しにいくのではなく、IEでまさに該当ページが既に開いている状況
 (まさに今ここです!)で、そこから該当情報をとりにいくVBA記述
・「複数のプルダウンを選択」→「送信」を加味した画面遷移後のURL指定方法
これらがVBAでできれば解決できそうと考えています。

どうぞよろしくお願い致します。









↓こちらの追加質問です。
http://q.hatena.ne.jp/1279613364

回答の条件
  • 1人1回まで
  • 13歳以上
  • 登録:2010/07/21 13:22:33
  • 終了:2010/07/26 17:10:58

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692010/07/21 13:48:48

ポイント40pt

IEの開いているページからソースを取得するように、前回のコードを変更しました。

Sub Sample2()
    Dim objShell As Object
    Dim objIE As Object
    Dim buf As String
    Dim stP As Long
    Dim edP As Long
    
    Set objShell = CreateObject("Shell.Application")
    For Each objIE In objShell.Windows
        If Right$(objIE.FullName, 12) = "iexplore.exe" Then
            buf = objIE.document.body.innerHTML
            
            stP = InStr(1, buf, "<a href=") + 9
            edP = InStr(stP, buf, ">") - 1
            
            MsgBox Mid(buf, stP, edP - stP)
        End If
    Next
End
id:miku1973

ありがとうございます!

前回の記述はURL部分が上手く抜けたのですが、今回のはURLとは違うものが抜けてしまうようです。

http://www.yahoo.co.jp/

でやりました。

ここだけ直せれば・・・

2010/07/21 14:33:42

その他の回答(1件)

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692010/07/21 13:48:48ここでベストアンサー

ポイント40pt

IEの開いているページからソースを取得するように、前回のコードを変更しました。

Sub Sample2()
    Dim objShell As Object
    Dim objIE As Object
    Dim buf As String
    Dim stP As Long
    Dim edP As Long
    
    Set objShell = CreateObject("Shell.Application")
    For Each objIE In objShell.Windows
        If Right$(objIE.FullName, 12) = "iexplore.exe" Then
            buf = objIE.document.body.innerHTML
            
            stP = InStr(1, buf, "<a href=") + 9
            edP = InStr(stP, buf, ">") - 1
            
            MsgBox Mid(buf, stP, edP - stP)
        End If
    Next
End
id:miku1973

ありがとうございます!

前回の記述はURL部分が上手く抜けたのですが、今回のはURLとは違うものが抜けてしまうようです。

http://www.yahoo.co.jp/

でやりました。

ここだけ直せれば・・・

2010/07/21 14:33:42
id:ken3memo No.2

ken3memo回答回数243ベストアンサー獲得回数752010/07/21 14:02:21

ポイント30pt

起動済みのIEを探して (テストで タイトルがはてな or URLにhatenaが含まれる)

リンク情報をデバック文字として出力してみました。

Option Explicit

Sub ie_test0721()
'CreateObject("Shell.Application") で
'通常のフォルダー表示ファイルエクスプローラーとIE(インターネットエクスプローラー)
'を.FullNameで区別する

    Dim objShell  As Object
    Dim objIE     As Object
    Dim n         As Integer
    
    'これで、エクスプローラーのウインドウを取得する
    Set objShell = CreateObject("Shell.Application")
      
    '後ろから消してく。頭から、For n=0 To objShell.Windows.Count - 1 のループでもいいけど
    '.Windowsでエクスプローラーとインターネットエクスプローラーにさわれる
    For n = objShell.Windows.Count To 1 Step -1 'MAXから-1ひいてく感じで後ろからチェック
        Set objIE = objShell.Windows(n - 1) 'n番目のウインドウを代入 配列が0からなので-1補正
        Debug.Print n
        Debug.Print ".FullName " & objIE.FullName
        Debug.Print ".locationURL " & objIE.locationURL
        
       '.FullNameで普通のファイルエクスプローラーとIE(インターネットエクスプローラー)を区別する
        If Right(UCase(objIE.FullName), 12) = "IEXPLORE.EXE" Then 'IEか?
            'タイトルやURLで判断する
            Debug.Print "URL " & objIE.locationURL
            Debug.Print "URL " & objIE.Document.Title
            
            'タイトルがXXXXだったら テストではてなを指定
            If InStr(objIE.locationURL, "はてな") > 0 Then  'instrでタイトル文字を探したり
                Exit For '見つかったので、Exitでループ抜ける
            End If
            
            'URLがXXXXだったら  テストで hatena を指定
            If InStr(objIE.locationURL, "hatena") > 0 Then 'URLに hatena があるか調べたり
                Exit For '見つかったので、Exitでループ抜ける
            End If
        End If
    Next
    Set objShell = Nothing

    '↑上で見つからなかった 判断
    If n = 0 Then 'ループを最後まで回ってしまった=見つからなかった n=0で判断
        MsgBox "タイトル や URL を開いている IEが見つかりません"
        Exit Sub 'テスト関数を抜ける・・・
    End If
    
    '見つかったので、IE上のリンクを操作する(値を取り出す)
        'テストで
    For n = 0 To objIE.Document.Links.Length - 1
        Debug.Print objIE.Document.Links(n).innerText  'アンカーテキスト
        Debug.Print objIE.Document.Links(n).href      'URL
    Next
    
    '本当に1番目のリンクでいいなら 配列が0からなのでLinks(0)かなぁ
    If MsgBox("リンク " & objIE.Document.Links(0).href & "をクリックしますか?", vbYesNo) = vbYes Then
        objIE.Document.Links(0).Click    '蛇足でクリックしてみた。
    End If
    '↑でも、ヘッダーで画像とかあると、一番目は違ったり
    
End Sub

手前味噌のページですが、 http://ken3-info.blog.ocn.ne.jp/objie/2009/09/urlie_785f.html を元に作成してみました。

バグや動作仕様の勘違いなどがあるかもしれませんが、試してみてください。

一部でも参考になるといいなぁ・・・と思いつつ、願いつつ、失礼します。

  • id:SALINGER
    なるほど、Document.Links(0)でいいのか。これではどうだろう。
    Sub Sample3()
    Dim objShell As Object
    Dim objIE As Object

    Set objShell = CreateObject("Shell.Application")
    For Each objIE In objShell.Windows
    If Right$(objIE.FullName, 12) = "iexplore.exe" Then
    MsgBox objIE.document.Links(0)
    End If
    Next
    End Sub
  • id:ken3memo
    コピー・貼り付けしてたら間違えた
    >'タイトルがXXXXだったら テストではてなを指定
    >If InStr(objIE.locationURL, "はてな") > 0 Then 'instrでタイトル文字を探したり
    ↑タイトルで探すなら、
    If InStr(objIE.Document.Title, "はてな") > 0 Then 'instrでタイトル文字を探したり
    objIE.Document.Title でした。

    http://www.yahoo.co.jp/ で 目的のURLが抜けないのは、たぶんヘッダーが画像のリンクになっているから?
    あと、中の人の好みだけど
    <a title="オークション" href="r/mauc">オークション</a>
    と、a title と 書く人がいるからかなぁ。。。

    私のパターンだと、オークションのリンク文字のURLを抜くなら
    For n = 0 To objIE.Document.Links.Length - 1
    If Instr(objIE.Document.Links(n).innerText,"オークション") > 0 Then 'アンカーテキスト
    Msgbox objIE.Document.Links(n).href 'URL
    Exit For
    End If
    Next
    かなぁ。
    蛇足で恥の追加をしないかなぁと心配しつつ、コメントを書き込んでみたり。。。

  • id:windofjuly
    うぃんど 2010/07/21 18:28:13
    私なら RegExp で抜きますが、どうでしょうか?

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません