我想复制若干网页上的链接到剪切板后，用VB【一键】得到这些链接的文字和网址
请问这样的代码怎么写？
文字 网址
文字 网址
文字 网址
以前找到过一个EXCEL中的VB开发工具用的模块代码，可以提取出网址出来
Public Function cH(x As Range)
cH = x.Hyperlinks(1).Address
End Function
但是每次还要打开EXCEL粘贴后，引用 cH 才行，比较麻烦，想用VB快速得到！
请大侠帮帮忙

加我了解一下，可以帮你

你想做一个【自定义收藏夹】？

取网页源码，处理就行了

【】找到一个代码，不过只能提取出链接的网址，没有文字，想要的结果是 一行一个链接文字+网址【】
'工程引用microsoft vbscript regular expression 5.5
Function RegExpTest(patrn, strng) 'patrn:需要查找的字符 strng:被查找的字符串
Dim regEx, Match, Matches ' 创建变量。
Set regEx = New RegExp ' 创建正则表达式。
regEx.Pattern = patrn ' 设置模式。'"\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*"'
regEx.IgnoreCase = True ' 设置是否区分大小写。
regEx.Global = True ' 设置全程匹配。
Set Matches = regEx.Execute(strng) ' 执行搜索。
For Each Match In Matches ' 循环遍历Matches集合。
RetStr = RetStr & Match.Value & vbCrLf
Next
RegExpTest = RetStr
End Function
Private Sub Command1_Click()
Dim URLRegExp As String, MailRegExp As String, ChiniRegExp As String
Dim FileName As String, sFile As String, MuName As String, Chans As String
Dim i As Long, arr() As String, arr1() As String, arr2() As String
URLRegExp = "http://([\w-]+\.)+[\w-]+(/[\w- ./?%&=]*)?" 'URL正则表达式
MailRegExp = "\w+([-+.]\w+)*@\w+([-.]\w+)*\.\w+([-.]\w+)*" '电子邮件正则表达式
ChiniRegExp = "[^\x00-\xff]* "
Open "d:\1.html" For Binary As #1
sFile = Space(LOF(1))
Get #1, , sFile
Close #1
Text1.Text = RegExpTest(URLRegExp, sFile)
End Sub
Private Sub Command2_Click()
'如何获得剪切板Clipboard.GetText中的链接？不通过加载1.html的方式
End Sub

网址发一下

搞定了
Dim I As Integer, S As String
Private Sub Command1_Click()
S = ""
For I = 0 To WebBrowser1.Document.links.length - 1
If WebBrowser1.Document.links.Item(I) <> S Then
List1.AddItem WebBrowser1.Document.links.Item(I).innerText & vbTab & WebBrowser1.Document.links.Item(I)
Text2.Text = Text2.Text & WebBrowser1.Document.links.Item(I) & Chr(13) & Chr(10)
S = WebBrowser1.Document.links.Item(I)
End If
Next I
Label1.Caption = "本网页共有超级连接：" & I & " 个"
End Sub
Private Sub Command2_Click()
'Text1.Text = "d:\1.html" '设置默认网址，也可以像这里直接读取本地的HTML文件
WebBrowser1.Navigate Text1.Text
End Sub
Private Sub Command3_Click()
For I = 0 To List1.ListCount - 1
Text3 = Text3 & vbCrLf & List1.List(I)
Next
End Sub