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
这样就可以达到你说的要求了吧？

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

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

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

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