|
Sub YZC51()
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
For i = 2 To Range("a1").End(xlDown).Row
n = Left(Cells(i, 1), 7)
URL = "http://www.ip138.com:8080/search.asp?mobile=" & n & "&action=mobile&B1=%B2%E9+%D1%AF"
.Open "GET", URL, False
.send
stext = Replace(Replace(StrConv(.responsebody, vbUnicode), "<TR>", ""), "<TR class=tdc bgcolor=#EFF1F3>", "")
stext = Replace(Replace(stext, "</TR>", ""), "<TR class=tdc bgcolor=#EFF1F3>", "")
'.responsetext
strtext = strtext & "<table>" & Split(Split(stext, "卡号归属地")(1), "更详细的")(0) & "</table>"
Next
End With
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
.SetText strtext
.PutInClipboard
End With
Range("b2").PasteSpecial
End Sub
|
|