如何同时取得网页中的超链接和它的(标题)文字

#2

bczgvip2012-09-01 21:20

程序代码：

Private Sub Command1_Click()
    Dim vTag, vDoc ' As HTMLDocument
    Dim Allcount, i
    List1.Clear
    Set vDoc = WebBrowser1.Document
    Set vTag = vDoc.getElementsByTagName("A")
    Allcount = vTag.length
    For i = 0 To Allcount - 1
        List1.AddItem vTag(i).href & "|" & vTag(i).innerText
    Next i
End Sub

innerText 自己改吧！

#3

anluboy2012-09-02 08:59

回复 2楼 bczgvip

斑竹大大帮我写个完整的吧我小白``谢谢了`

#4

anluboy2012-09-02 09:03

或者帮我注释以下谢谢了`

#5

anluboy2012-09-02 09:12

我现在获取连接的方式如下。。。
我要在LIST2里显示标题///
Private Sub Command1_Click()
Dim vTag, vDoc
Dim Allcount, i
List1.Clear
Set vDoc = WebBrowser1.Document.All
Allcount = vDoc.length
For i = 0 To Allcount - 1
If UCase(vDoc.Item(i).TagName) = "A" Then           '找到URL
vTag = vDoc.Item(i).href
If InStr(vTag, ".shtml") Then         '检测URL中是否含有[url]http://XXX.[/url]
List1.AddItem vDoc.Item(i).href     '如果有,则添加到list1中
End If
End If
Next i
End Sub

#6

bczgvip2012-09-02 11:16

    For i = 0 To Allcount - 1
        if instr( vtag(i).href, ".shtml") >0 then
            List1.AddItem vTag(i).href & " | " & vTag(i).innerText '标题？innerText 是显示出来的文本
        endif
    Next i

#7

anluboy2012-09-02 15:36

回复 6楼 bczgvip

大大好象不行`

#8

anluboy2012-09-02 15:43

回复 6楼 bczgvip

你可能没有看清楚内容``是这样的，我建立了2个LIST ，LIST1读取页面连接。LIST2存放连接title标签的内容`
比如我从https://bbs.bccn.net/forumdisplay.php?fid=6&page=1读取了这个帖子的连接
https://bbs.bccn.net/post.php?action=reply&fid=6&tid=380503&reply=2148405&floor=6&extra=&page=1
存放到LIST1，我现在需要将https://bbs.bccn.net/post.php?action=reply&fid=6&tid=380503&reply=2148405&floor=6&extra=&page=1的title标签内容同时存放到LIST2里面。

#9

anluboy2012-09-02 15:57

回复 6楼 bczgvip

非常感谢大大```我在网上找了段代码。
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Set webdoc = WebBrowser1.Document
    Dim Acollection As Object
    Set Acollection = webdoc.All.tags("a")
    For i = 0 To Acollection.length - 1
      List1.AddItem Acollection.Item(i)
      List2.AddItem Acollection.Item(i).innertext
    Next
End Sub
如何在我点击按钮1的时候开始提取

这段代码可以提取当前页面的所有连接。。。但是不知道怎么提取指定的连接`比如我要提取的是*.SHTML

[ 本帖最后由 anluboy 于 2012-9-2 16:07 编辑 ]

#10

tang6882012-09-03 11:03

用正则很方便的，读取整页的内容，筛选出特点条件内容
比如：<a harf=...... %%%%%%>*******</a>这是一种较为普通的方式，你可以通过正则方便地筛选出******内容。也能筛选出.....内容，用于进一步打开联接
然后可以进一步筛选......条件是.SHTML

[ 本帖最后由 tang688 于 2012-9-3 11:07 编辑 ]

#11

tang6882012-09-03 11:10

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
     Set webdoc = WebBrowser1.Document
     Dim Acollection As Object
     Set Acollection = webdoc.All.tags("a")
     For i = 0 To Acollection.length - 1
       if instr(Acollection.Item(i),".SHTML") then
         List1.AddItem Acollection.Item(i)
         List2.AddItem Acollection.Item(i).innertext
       end if
     Next
End Sub
这样就可以达到你说的要求了吧？

#12

anluboy2012-09-03 13:45

回复 10楼 tang688

能帮我写一下吗？谢谢泐```

#13

anluboy2012-09-03 14:35

回复 11楼 tang688

谢谢大大```可以了``能加你QQ吗？

#14

a8141532013-05-02 11:07

Private Sub CommandButton2_Click()
    On Error Resume Next
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "https://bbs.bccn.net/forumdisplay.php?fid=6&page=1", False
        .send
        ss = "https://bbs.bccn.net/post.php" & Split(Split(.responsetext, """><img")(1), "http://bbs.bccn.net/post.php")(1)
        .Open "GET", ss, False
        .send
        Debug.Print Split(Split(.responsetext, "<title>")(1), "</title>")(0)
    End With
End Sub

#15

WEBDDNS2017-10-06 21:24

对,提议用正则,速度快,少加载.

如何同时取得网页中的 超链接 和它的(标题)文字