WebBrowserのリンク先取得について

解決

---

WebBrowserでブラウザをつくっています
リンク文字の上にマウスポインタを合わせると指のアイコンになりますが
その時にそのリンク先のURLを取得できますでしょうか

よろしくお願いします

編集 削除

---

IHTMLAnchorElement インターフェイスの hrefプロパティを使えば、
URLを取得できます。

編集 削除

---

IHTMLAnchorElementインターフェイス・・・が、さっぱりわかりません

申し訳ありませんが、教えていただけますでしょうか

編集 削除

---

こちらですね。
http://msdn.microsoft.com/workshop/browser/mshtml/reference/ifaces/anchorelement/anchorelement.asp
http://msdn.microsoft.com/workshop/author/dhtml/reference/objects/a.asp

VBからは、MSHTML.TLB ファイルを参照設定する事で使えます。
HTML文書の表示が完了した後で、
  Dim doc As MSHTML.HTMLDocument
  Set doc = WebBrowser1.Document
のようなコードを書き、このdocオブジェクトの各種プロパティを、
オブジェクトブラウザなどを使って、いろいろと調べて見てください。

# DHTMLに関する知識があると、理解が早いかも。

編集 削除

---

早速ありがとうございます

まだまださっぱりわかりませんが、調べてみます

編集 削除

---

こんな具合でどうでしょうか。

' 参照設定: Microsoft HTML Object Library (MSHTML.tlb)
Option Explicit

Private WithEvents HtmlDoc As HTMLDocument

Private Sub Form_Load()
    WebBrowser1.Navigate2 "http://madia.world.coocan.jp/cgi-bin/VBBBS2/wwwlng.cgi"
End Sub

Private Sub HtmlDoc_onmouseout()
    Text1.Text = ""
End Sub

Private Sub HtmlDoc_onmouseover()
    Dim oElement As IHTMLElement
    Set oElement = HtmlDoc.parentWindow.event.srcElement
    If (oElement.tagName <> "A") Then
        Set oElement = oElement.parentElement
    End If
    If (oElement.tagName = "A") Then
        Text1.Text = oElement.innerText & vbNewLine & oElement.href
    End If
    Set oElement = Nothing
End Sub

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    Set HtmlDoc = Nothing
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Set HtmlDoc = WebBrowser1.Document
End Sub

編集 削除

---

ueoさん
わざわざコードまで書いていただきまして、ありがとうございます
ちょうど諦めてコードを教えてもらおうかと思っていたところでした

コードをよく読んで内容を理解した上で使わせていただきたいと思います


またプログラムができたら解決チェックしに来ます
ありがとうございました

編集 削除

---

ueoさんのコードで試してみたところできたのですが
フレームで構成されているページではできませんでした

対処法がありましたらお願いします

編集 削除

---

私もつい先日このサイトでご指導いただいたばかりです。

>フレームで構成されているページではできませんでした

参考になるかも・・・・・。
http://madia.world.coocan.jp/cgi-bin/VBBBS2/wwwlng.cgi?print+200505/05050054.txt

編集 削除

---

ＷＥＢ太郎さん
Set HtmlDoc = WebBrowser1.Document  の後にフレームを記述すればいいのでしょうか・・・
そのサイトにあるフレームの数はどうやって取得できるかご存知でしょうか

もしわかったらお願いします

お願いばかりで申し訳ありません・・・

編集 削除

---

緒太助さん  こんにちは。
ページに構成や各フレームのHTML等々構成される全てをＩＥで一旦ダウンロード
して全体を掌握されたらいかがでしょう。（対象のページが固定の場合ですが）
ファイル→名前を付けて保存で全てダウンロードできます。
対象のページが固定でない場合は、その都度トップページのHTMLからFRAMEの構成をしらべるしかないのでは・・・・。
getElementsByTagNameなどをお調べください。

編集 削除

---

未だ解決していなかったんですね。
簡単なフレーム構成に対応するサンプルを載せておきます。

' 参照設定: Microsoft HTML Object Library (MSHTML.tlb)
Option Explicit
Private m_sFrameLocation As String
Private m_sIFrameLocation As String
Private WithEvents MainDoc As HTMLDocument
Private WithEvents frameDoc As HTMLDocument
Private WithEvents iframeDoc As HTMLDocument

Private Sub Form_Load()
    WebBrowser1.Navigate2 "http://www.bcap.co.jp/hanafusa/index.html"
End Sub

Private Sub WebBrowser1_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, Flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
    Set MainDoc = Nothing
    Set frameDoc = Nothing
    Set iframeDoc = Nothing
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    If (WebBrowser1.Document Is Nothing) Then Exit Sub
    Set MainDoc = WebBrowser1.Document
End Sub

Private Sub MainDoc_onmouseout()
    Text1.Text = ""
End Sub

Private Sub MainDoc_onmouseover()
    Dim oElement As IHTMLElement
    Set oElement = MainDoc.parentWindow.event.srcElement
    Select Case UCase(oElement.tagName)
    Case "FRAMESET"
    Case "FRAME"
        If (Len(m_sFrameLocation) = 0) Or _
                (m_sFrameLocation <> oElement.LocationURL) Then
            Dim i As Long
            For i = 0 To MainDoc.frames.length - 1
                If (oElement.LocationURL = MainDoc.frames.Item(i).location) Then
                    Set frameDoc = MainDoc.frames.Item(i).Document
                    m_sFrameLocation = MainDoc.frames.Item(i).location
                    Exit For
                End If
            Next
        End If
    Case Else
        Do While (oElement.tagName <> "A")
            Set oElement = oElement.parentElement
            If (oElement Is Nothing) Then Exit Sub
        Loop
        Text1.Text = oElement.innerText & vbNewLine & oElement.href
    End Select
    Set oElement = Nothing
End Sub

Private Sub frameDoc_onmouseout()
    Text1.Text = ""
End Sub

Private Sub frameDoc_onmouseover()
    Dim oElement As IHTMLElement
    Set oElement = frameDoc.parentWindow.event.srcElement
    Select Case UCase(oElement.tagName)
    Case "IFRAME"
        If (Len(m_sIFrameLocation) = 0) Or _
                (m_sIFrameLocation <> oElement.LocationURL) Then
            Dim i As Long
            For i = 0 To frameDoc.frames.length - 1
                If (oElement.LocationURL = frameDoc.frames.Item(i).location) Then
                    Set iframeDoc = frameDoc.frames.Item(i).Document
                    m_sIFrameLocation = frameDoc.frames.Item(i).location
                    Exit For
                End If
            Next
        End If
    Case Else
        Do While (oElement.tagName <> "A")
            Set oElement = oElement.parentElement
            If (oElement Is Nothing) Then Exit Sub
        Loop
        Text1.Text = oElement.innerText & vbNewLine & oElement.href
    End Select
    Set oElement = Nothing
End Sub

Private Sub iframeDoc_onmouseout()
    Text1.Text = ""
End Sub

Private Sub iframeDoc_onmouseover()
    Dim oElement As IHTMLElement
    Set oElement = iframeDoc.parentWindow.event.srcElement
    Do While (oElement.tagName <> "A")
        Set oElement = oElement.parentElement
        If (oElement Is Nothing) Then Exit Sub
    Loop
    Text1.Text = oElement.innerText & vbNewLine & oElement.href
    Set oElement = Nothing
End Sub

編集 削除

---

ueoさん
ありがとうございます
ずっと悩んでました・・・


またコードをよく読んで取り入れさせて頂きたいと思います

プログラムができたらまた解決チェックしに来ます
ありがとうございました

編集 削除

---

コードがうまく働きませんでした・・・
が、HTMLDocumentとIHTMLElement辺りをもっと調べてみたいと思います


ありがとうございました

編集 削除

---

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

←解決時は質問者本人がここをチェックしてください。