首先生成链接,之后选中链接运行即可
Sub api()
On Error Resume Next
For Each url In Selection
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", url, False
.send
sText = .responsetext
End With
Dim oRegExp As Object
Dim oMatches As Object
Set oRegExp = CreateObject("vbscript.regexp")
With oRegExp
.Global = True
.ignoreCase = True
.Pattern = "\>(\d.*?)\<"
Set oMatches = .Execute(sText)
a = 1
For i = 0 To oMatches.Count - 1 Step 1
url.Offset(0, a) = oMatches.Item(i).submatches.Item(0)
a = a + 1
Next
End With
Next
Set oRegExp = Nothing
Set oMatches = Nothing
End Sub